From 4bbd1cfed82db5f548b4aa3ba64ca63557ebcf70 Mon Sep 17 00:00:00 2001 From: Peter S Galbraith Date: Mon, 21 Nov 2016 13:20:03 -0700 Subject: emacs-goodies-el (36.3) unstable; urgency=high * emacs-goodies-el: - Bug fix: "fails to upgrade/install", thanks to Brent S. Elmer (Closes: #845216). Skip byte-compilation for minibuffer-complete-cycle.el on emacs23. [dgit import package emacs-goodies-el 36.3] --- 00AddingFiles | 82 + COPYING-GPL-v2 | 339 + COPYING-GPL-v3 | 676 + debian/README.Debian | 310 + debian/README.source | 17 + debian/changelog | 3083 +++++ debian/compat | 1 + debian/control | 152 + debian/copyright | 2 + debian/debian-el.README.Debian | 35 + debian/debian-el.copyright | 66 + debian/debian-el.emacsen-compat | 1 + debian/debian-el.emacsen-install.in | 35 + debian/debian-el.emacsen-remove.in | 5 + debian/debian-el.emacsen-startup | 18 + debian/debian-el.info | 1 + debian/debian-el.install | 8 + debian/debian-el.postinst | 21 + debian/devscripts-el.README.Debian | 36 + debian/devscripts-el.copyright | 44 + debian/devscripts-el.emacsen-compat | 1 + debian/devscripts-el.emacsen-install.in | 37 + debian/devscripts-el.emacsen-remove.in | 5 + debian/devscripts-el.emacsen-startup | 35 + debian/devscripts-el.install | 3 + debian/dpkg-dev-el.README.Debian | 35 + debian/dpkg-dev-el.copyright | 60 + debian/dpkg-dev-el.emacsen-compat | 1 + debian/dpkg-dev-el.emacsen-install.in | 23 + debian/dpkg-dev-el.emacsen-remove.in | 5 + debian/dpkg-dev-el.emacsen-startup | 18 + debian/dpkg-dev-el.install | 7 + debian/emacs-goodies-el.copyright | 527 + debian/emacs-goodies-el.emacsen-compat | 1 + debian/emacs-goodies-el.emacsen-install.in | 27 + debian/emacs-goodies-el.emacsen-remove.in | 5 + debian/emacs-goodies-el.emacsen-startup | 19 + debian/emacs-goodies-el.info | 2 + debian/emacs-goodies-el.install | 84 + debian/emacsen-install.template | 103 + debian/emacsen-remove.template | 5 + debian/patches/40_missing_provide.diff | 10 + debian/patches/49_bar-cursor-customize.diff | 162 + debian/patches/50_bar-cursor_bug331430.diff | 13 + debian/patches/50_browse-kill-ring_bug224751.diff | 16 + debian/patches/50_coffee_no-autoload.diff | 12 + debian/patches/50_color-theme_custom.diff | 26 + debian/patches/50_ctypes.diff | 303 + debian/patches/50_dedicated.diff | 53 + debian/patches/50_diminish-defcustom.diff | 153 + debian/patches/50_edit-env_autoload.diff | 12 + debian/patches/50_filladapt_bug420845.diff | 21 + debian/patches/50_gnus-BTS.diff | 186 + .../patches/50_highlight-beyond-fill-column.diff | 181 + debian/patches/50_joc-toggle-buffer.diff | 75 + debian/patches/50_joc-toggle-case.diff | 181 + debian/patches/50_maplevtexi.diff | 45 + debian/patches/50_marker-visit_autoloads.diff | 28 + debian/patches/50_minibuf-electric.diff | 23 + debian/patches/50_protbuf_custom_and_toggle.diff | 161 + debian/patches/50_quack_autoload.diff | 100 + debian/patches/50_rfcview.diff | 11 + debian/patches/50_session_enable_custom.diff | 18 + debian/patches/50_setnu.diff | 229 + debian/patches/50_silly-mail.diff | 1081 ++ debian/patches/50_slang-mode_bug336352.diff | 13 + debian/patches/50_tc.diff | 177 + debian/patches/50_tlc.diff | 13 + debian/patches/50_todoo_bug220718.diff | 26 + debian/patches/51_diminishSamuelBronson.diff | 81 + debian/patches/51_edit-env_copy-list.diff | 30 + debian/patches/51_gnus-BTS_bug363161.diff | 34 + debian/patches/51_session_autoload.diff | 12 + debian/patches/51_todoo_bug267637.diff | 31 + debian/patches/52_gnus-BTS_bug218286.diff | 60 + debian/patches/52_todoo_bug414781.diff | 29 + debian/patches/53_todoo_bug438964.diff | 49 + debian/patches/56_make_local_hook.diff | 22 + debian/patches/series | 37 + debian/rules | 25 + debian/source/format | 1 + elisp/debian-el/apt-sources.el | 524 + elisp/debian-el/apt-utils.el | 2116 +++ elisp/debian-el/deb-view.el | 715 + elisp/debian-el/debian-bug.el | 2412 ++++ elisp/debian-el/debian-el-loaddefs.el | 175 + elisp/debian-el/debian-el-loaddefs.make | 1 + elisp/debian-el/debian-el.el | 104 + elisp/debian-el/debian-el.texi | 331 + elisp/debian-el/gnus-BTS.el | 124 + elisp/debian-el/preseed.el | 48 + elisp/devscripts-el/ChangeLog | 322 + elisp/devscripts-el/devscripts.el | 178 + elisp/devscripts-el/pbuilder-log-view-mode.el | 244 + elisp/devscripts-el/pbuilder-mode.el | 122 + elisp/dpkg-dev-el/debian-bts-control.el | 1231 ++ elisp/dpkg-dev-el/debian-changelog-mode.el | 1814 +++ elisp/dpkg-dev-el/debian-control-mode.el | 525 + elisp/dpkg-dev-el/debian-copyright.el | 97 + elisp/dpkg-dev-el/dpkg-dev-el-loaddefs.el | 116 + elisp/dpkg-dev-el/dpkg-dev-el-loaddefs.make | 1 + elisp/dpkg-dev-el/dpkg-dev-el.el | 106 + elisp/dpkg-dev-el/readme-debian.el | 126 + elisp/emacs-goodies-el/align-string.el | 100 + elisp/emacs-goodies-el/all.el | 228 + elisp/emacs-goodies-el/apache-mode.el | 829 ++ elisp/emacs-goodies-el/ascii.el | 975 ++ elisp/emacs-goodies-el/auto-fill-inhibit.el | 89 + elisp/emacs-goodies-el/bar-cursor.el | 187 + elisp/emacs-goodies-el/bm.el | 1342 ++ elisp/emacs-goodies-el/boxquote.el | 585 + elisp/emacs-goodies-el/browse-huge-tar.el | 235 + elisp/emacs-goodies-el/browse-kill-ring.el | 1050 ++ elisp/emacs-goodies-el/button-lock.el | 1076 ++ elisp/emacs-goodies-el/clipper.el | 355 + elisp/emacs-goodies-el/coffee.el | 115 + elisp/emacs-goodies-el/color-theme-library.el | 13539 +++++++++++++++++++ elisp/emacs-goodies-el/color-theme.el | 1669 +++ elisp/emacs-goodies-el/color-theme_seldefcustom.el | 49 + elisp/emacs-goodies-el/csv-mode.el | 1286 ++ elisp/emacs-goodies-el/ctypes.el | 1742 +++ elisp/emacs-goodies-el/dedicated.el | 53 + elisp/emacs-goodies-el/df.el | 280 + elisp/emacs-goodies-el/diminish.el | 293 + elisp/emacs-goodies-el/dir-locals.el | 183 + elisp/emacs-goodies-el/edit-env.el | 186 + elisp/emacs-goodies-el/egocentric.el | 336 + elisp/emacs-goodies-el/emacs-goodies-build.el | 169 + elisp/emacs-goodies-el/emacs-goodies-custom.el | 570 + elisp/emacs-goodies-el/emacs-goodies-el.el | 307 + elisp/emacs-goodies-el/emacs-goodies-el.texi | 4018 ++++++ elisp/emacs-goodies-el/emacs-goodies-loaddefs.make | 1 + elisp/emacs-goodies-el/eproject-extras.el | 308 + elisp/emacs-goodies-el/eproject.el | 679 + elisp/emacs-goodies-el/ff-paths.el | 1039 ++ elisp/emacs-goodies-el/filladapt.el | 981 ++ elisp/emacs-goodies-el/floatbg.el | 205 + elisp/emacs-goodies-el/folding.el | 5413 ++++++++ elisp/emacs-goodies-el/framepop.el | 939 ++ elisp/emacs-goodies-el/graphviz-dot-mode.el | 944 ++ .../highlight-beyond-fill-column.el | 125 + elisp/emacs-goodies-el/highlight-completion.el | 1614 +++ elisp/emacs-goodies-el/highlight-current-line.el | 405 + elisp/emacs-goodies-el/home-end.el | 98 + elisp/emacs-goodies-el/htmlize.el | 1769 +++ elisp/emacs-goodies-el/initsplit.el | 219 + elisp/emacs-goodies-el/joc-toggle-buffer.el | 239 + elisp/emacs-goodies-el/joc-toggle-case.el | 317 + elisp/emacs-goodies-el/keydef.el | 395 + elisp/emacs-goodies-el/keywiz.el | 323 + elisp/emacs-goodies-el/lcomp.el | 253 + elisp/emacs-goodies-el/map-lines.el | 167 + elisp/emacs-goodies-el/maplev.el | 5430 ++++++++ elisp/emacs-goodies-el/maplev.texi | 1501 ++ elisp/emacs-goodies-el/marker-visit.el | 131 + elisp/emacs-goodies-el/matlab.el | 5814 ++++++++ elisp/emacs-goodies-el/minibuf-electric.el | 121 + .../emacs-goodies-el/minibuffer-complete-cycle.el | 266 + elisp/emacs-goodies-el/miniedit.el | 427 + elisp/emacs-goodies-el/mutt-alias.el | 126 + elisp/emacs-goodies-el/muttrc-mode.el | 1638 +++ elisp/emacs-goodies-el/nuke-trailing-whitespace.el | 163 + elisp/emacs-goodies-el/obfusurl.el | 114 + elisp/emacs-goodies-el/pack-windows.el | 224 + elisp/emacs-goodies-el/perldoc.el | 296 + elisp/emacs-goodies-el/pod-mode.el | 706 + elisp/emacs-goodies-el/pp-c-l.el | 265 + elisp/emacs-goodies-el/projects.el | 234 + elisp/emacs-goodies-el/protbuf.el | 175 + elisp/emacs-goodies-el/protocols.el | 166 + elisp/emacs-goodies-el/quack.el | 4820 +++++++ elisp/emacs-goodies-el/rfcview.el | 860 ++ elisp/emacs-goodies-el/services.el | 184 + elisp/emacs-goodies-el/session.el | 1726 +++ elisp/emacs-goodies-el/setnu.el | 448 + elisp/emacs-goodies-el/shell-command.el | 405 + elisp/emacs-goodies-el/show-wspace.el | 257 + elisp/emacs-goodies-el/silly-mail.el | 752 + elisp/emacs-goodies-el/slang-mode.el | 709 + elisp/emacs-goodies-el/sys-apropos.el | 118 + elisp/emacs-goodies-el/tabbar.el | 1932 +++ elisp/emacs-goodies-el/tail.el | 206 + elisp/emacs-goodies-el/tc.el | 1196 ++ elisp/emacs-goodies-el/thinks.el | 271 + elisp/emacs-goodies-el/tlc.el | 307 + elisp/emacs-goodies-el/tld.el | 356 + elisp/emacs-goodies-el/todoo.el | 544 + elisp/emacs-goodies-el/toggle-option.el | 177 + elisp/emacs-goodies-el/twiddle.el | 283 + elisp/emacs-goodies-el/under.el | 66 + elisp/emacs-goodies-el/upstart-mode.el | 83 + elisp/emacs-goodies-el/xrdb-mode.el | 553 + make-orig.sh | 25 + 193 files changed, 103461 insertions(+) create mode 100755 00AddingFiles create mode 100755 COPYING-GPL-v2 create mode 100755 COPYING-GPL-v3 create mode 100644 debian/README.Debian create mode 100644 debian/README.source create mode 100644 debian/changelog create mode 100644 debian/compat create mode 100644 debian/control create mode 100644 debian/copyright create mode 100644 debian/debian-el.README.Debian create mode 100644 debian/debian-el.copyright create mode 100644 debian/debian-el.emacsen-compat create mode 100644 debian/debian-el.emacsen-install.in create mode 100644 debian/debian-el.emacsen-remove.in create mode 100644 debian/debian-el.emacsen-startup create mode 100644 debian/debian-el.info create mode 100644 debian/debian-el.install create mode 100644 debian/debian-el.postinst create mode 100644 debian/devscripts-el.README.Debian create mode 100644 debian/devscripts-el.copyright create mode 100644 debian/devscripts-el.emacsen-compat create mode 100644 debian/devscripts-el.emacsen-install.in create mode 100644 debian/devscripts-el.emacsen-remove.in create mode 100644 debian/devscripts-el.emacsen-startup create mode 100644 debian/devscripts-el.install create mode 100644 debian/dpkg-dev-el.README.Debian create mode 100644 debian/dpkg-dev-el.copyright create mode 100644 debian/dpkg-dev-el.emacsen-compat create mode 100644 debian/dpkg-dev-el.emacsen-install.in create mode 100644 debian/dpkg-dev-el.emacsen-remove.in create mode 100644 debian/dpkg-dev-el.emacsen-startup create mode 100644 debian/dpkg-dev-el.install create mode 100644 debian/emacs-goodies-el.copyright create mode 100644 debian/emacs-goodies-el.emacsen-compat create mode 100644 debian/emacs-goodies-el.emacsen-install.in create mode 100644 debian/emacs-goodies-el.emacsen-remove.in create mode 100644 debian/emacs-goodies-el.emacsen-startup create mode 100644 debian/emacs-goodies-el.info create mode 100644 debian/emacs-goodies-el.install create mode 100644 debian/emacsen-install.template create mode 100644 debian/emacsen-remove.template create mode 100644 debian/patches/40_missing_provide.diff create mode 100644 debian/patches/49_bar-cursor-customize.diff create mode 100644 debian/patches/50_bar-cursor_bug331430.diff create mode 100644 debian/patches/50_browse-kill-ring_bug224751.diff create mode 100644 debian/patches/50_coffee_no-autoload.diff create mode 100644 debian/patches/50_color-theme_custom.diff create mode 100644 debian/patches/50_ctypes.diff create mode 100644 debian/patches/50_dedicated.diff create mode 100644 debian/patches/50_diminish-defcustom.diff create mode 100644 debian/patches/50_edit-env_autoload.diff create mode 100644 debian/patches/50_filladapt_bug420845.diff create mode 100644 debian/patches/50_gnus-BTS.diff create mode 100644 debian/patches/50_highlight-beyond-fill-column.diff create mode 100644 debian/patches/50_joc-toggle-buffer.diff create mode 100644 debian/patches/50_joc-toggle-case.diff create mode 100755 debian/patches/50_maplevtexi.diff create mode 100644 debian/patches/50_marker-visit_autoloads.diff create mode 100644 debian/patches/50_minibuf-electric.diff create mode 100644 debian/patches/50_protbuf_custom_and_toggle.diff create mode 100644 debian/patches/50_quack_autoload.diff create mode 100644 debian/patches/50_rfcview.diff create mode 100644 debian/patches/50_session_enable_custom.diff create mode 100644 debian/patches/50_setnu.diff create mode 100644 debian/patches/50_silly-mail.diff create mode 100644 debian/patches/50_slang-mode_bug336352.diff create mode 100644 debian/patches/50_tc.diff create mode 100644 debian/patches/50_tlc.diff create mode 100644 debian/patches/50_todoo_bug220718.diff create mode 100644 debian/patches/51_diminishSamuelBronson.diff create mode 100644 debian/patches/51_edit-env_copy-list.diff create mode 100644 debian/patches/51_gnus-BTS_bug363161.diff create mode 100644 debian/patches/51_session_autoload.diff create mode 100644 debian/patches/51_todoo_bug267637.diff create mode 100644 debian/patches/52_gnus-BTS_bug218286.diff create mode 100644 debian/patches/52_todoo_bug414781.diff create mode 100644 debian/patches/53_todoo_bug438964.diff create mode 100644 debian/patches/56_make_local_hook.diff create mode 100644 debian/patches/series create mode 100755 debian/rules create mode 100755 debian/source/format create mode 100755 elisp/debian-el/apt-sources.el create mode 100644 elisp/debian-el/apt-utils.el create mode 100755 elisp/debian-el/deb-view.el create mode 100755 elisp/debian-el/debian-bug.el create mode 100755 elisp/debian-el/debian-el-loaddefs.el create mode 100755 elisp/debian-el/debian-el-loaddefs.make create mode 100755 elisp/debian-el/debian-el.el create mode 100755 elisp/debian-el/debian-el.texi create mode 100755 elisp/debian-el/gnus-BTS.el create mode 100755 elisp/debian-el/preseed.el create mode 100755 elisp/devscripts-el/ChangeLog create mode 100755 elisp/devscripts-el/devscripts.el create mode 100755 elisp/devscripts-el/pbuilder-log-view-mode.el create mode 100755 elisp/devscripts-el/pbuilder-mode.el create mode 100755 elisp/dpkg-dev-el/debian-bts-control.el create mode 100755 elisp/dpkg-dev-el/debian-changelog-mode.el create mode 100755 elisp/dpkg-dev-el/debian-control-mode.el create mode 100755 elisp/dpkg-dev-el/debian-copyright.el create mode 100755 elisp/dpkg-dev-el/dpkg-dev-el-loaddefs.el create mode 100755 elisp/dpkg-dev-el/dpkg-dev-el-loaddefs.make create mode 100755 elisp/dpkg-dev-el/dpkg-dev-el.el create mode 100755 elisp/dpkg-dev-el/readme-debian.el create mode 100755 elisp/emacs-goodies-el/align-string.el create mode 100755 elisp/emacs-goodies-el/all.el create mode 100644 elisp/emacs-goodies-el/apache-mode.el create mode 100644 elisp/emacs-goodies-el/ascii.el create mode 100755 elisp/emacs-goodies-el/auto-fill-inhibit.el create mode 100755 elisp/emacs-goodies-el/bar-cursor.el create mode 100755 elisp/emacs-goodies-el/bm.el create mode 100755 elisp/emacs-goodies-el/boxquote.el create mode 100755 elisp/emacs-goodies-el/browse-huge-tar.el create mode 100755 elisp/emacs-goodies-el/browse-kill-ring.el create mode 100644 elisp/emacs-goodies-el/button-lock.el create mode 100755 elisp/emacs-goodies-el/clipper.el create mode 100755 elisp/emacs-goodies-el/coffee.el create mode 100755 elisp/emacs-goodies-el/color-theme-library.el create mode 100755 elisp/emacs-goodies-el/color-theme.el create mode 100755 elisp/emacs-goodies-el/color-theme_seldefcustom.el create mode 100755 elisp/emacs-goodies-el/csv-mode.el create mode 100755 elisp/emacs-goodies-el/ctypes.el create mode 100755 elisp/emacs-goodies-el/dedicated.el create mode 100755 elisp/emacs-goodies-el/df.el create mode 100755 elisp/emacs-goodies-el/diminish.el create mode 100755 elisp/emacs-goodies-el/dir-locals.el create mode 100755 elisp/emacs-goodies-el/edit-env.el create mode 100755 elisp/emacs-goodies-el/egocentric.el create mode 100755 elisp/emacs-goodies-el/emacs-goodies-build.el create mode 100755 elisp/emacs-goodies-el/emacs-goodies-custom.el create mode 100755 elisp/emacs-goodies-el/emacs-goodies-el.el create mode 100644 elisp/emacs-goodies-el/emacs-goodies-el.texi create mode 100755 elisp/emacs-goodies-el/emacs-goodies-loaddefs.make create mode 100644 elisp/emacs-goodies-el/eproject-extras.el create mode 100644 elisp/emacs-goodies-el/eproject.el create mode 100755 elisp/emacs-goodies-el/ff-paths.el create mode 100755 elisp/emacs-goodies-el/filladapt.el create mode 100755 elisp/emacs-goodies-el/floatbg.el create mode 100755 elisp/emacs-goodies-el/folding.el create mode 100755 elisp/emacs-goodies-el/framepop.el create mode 100755 elisp/emacs-goodies-el/graphviz-dot-mode.el create mode 100755 elisp/emacs-goodies-el/highlight-beyond-fill-column.el create mode 100755 elisp/emacs-goodies-el/highlight-completion.el create mode 100755 elisp/emacs-goodies-el/highlight-current-line.el create mode 100755 elisp/emacs-goodies-el/home-end.el create mode 100755 elisp/emacs-goodies-el/htmlize.el create mode 100755 elisp/emacs-goodies-el/initsplit.el create mode 100755 elisp/emacs-goodies-el/joc-toggle-buffer.el create mode 100755 elisp/emacs-goodies-el/joc-toggle-case.el create mode 100755 elisp/emacs-goodies-el/keydef.el create mode 100755 elisp/emacs-goodies-el/keywiz.el create mode 100755 elisp/emacs-goodies-el/lcomp.el create mode 100755 elisp/emacs-goodies-el/map-lines.el create mode 100644 elisp/emacs-goodies-el/maplev.el create mode 100644 elisp/emacs-goodies-el/maplev.texi create mode 100755 elisp/emacs-goodies-el/marker-visit.el create mode 100644 elisp/emacs-goodies-el/matlab.el create mode 100755 elisp/emacs-goodies-el/minibuf-electric.el create mode 100644 elisp/emacs-goodies-el/minibuffer-complete-cycle.el create mode 100755 elisp/emacs-goodies-el/miniedit.el create mode 100755 elisp/emacs-goodies-el/mutt-alias.el create mode 100755 elisp/emacs-goodies-el/muttrc-mode.el create mode 100755 elisp/emacs-goodies-el/nuke-trailing-whitespace.el create mode 100755 elisp/emacs-goodies-el/obfusurl.el create mode 100755 elisp/emacs-goodies-el/pack-windows.el create mode 100755 elisp/emacs-goodies-el/perldoc.el create mode 100755 elisp/emacs-goodies-el/pod-mode.el create mode 100755 elisp/emacs-goodies-el/pp-c-l.el create mode 100755 elisp/emacs-goodies-el/projects.el create mode 100755 elisp/emacs-goodies-el/protbuf.el create mode 100755 elisp/emacs-goodies-el/protocols.el create mode 100644 elisp/emacs-goodies-el/quack.el create mode 100644 elisp/emacs-goodies-el/rfcview.el create mode 100755 elisp/emacs-goodies-el/services.el create mode 100755 elisp/emacs-goodies-el/session.el create mode 100755 elisp/emacs-goodies-el/setnu.el create mode 100755 elisp/emacs-goodies-el/shell-command.el create mode 100755 elisp/emacs-goodies-el/show-wspace.el create mode 100755 elisp/emacs-goodies-el/silly-mail.el create mode 100755 elisp/emacs-goodies-el/slang-mode.el create mode 100755 elisp/emacs-goodies-el/sys-apropos.el create mode 100755 elisp/emacs-goodies-el/tabbar.el create mode 100755 elisp/emacs-goodies-el/tail.el create mode 100755 elisp/emacs-goodies-el/tc.el create mode 100755 elisp/emacs-goodies-el/thinks.el create mode 100755 elisp/emacs-goodies-el/tlc.el create mode 100755 elisp/emacs-goodies-el/tld.el create mode 100755 elisp/emacs-goodies-el/todoo.el create mode 100755 elisp/emacs-goodies-el/toggle-option.el create mode 100755 elisp/emacs-goodies-el/twiddle.el create mode 100755 elisp/emacs-goodies-el/under.el create mode 100755 elisp/emacs-goodies-el/upstart-mode.el create mode 100755 elisp/emacs-goodies-el/xrdb-mode.el create mode 100755 make-orig.sh diff --git a/00AddingFiles b/00AddingFiles new file mode 100755 index 0000000..5b4d1c3 --- /dev/null +++ b/00AddingFiles @@ -0,0 +1,82 @@ +This is a checklist for adding files to the emacs-goodies-el package. + +- Make sure the upstream file can be used and customized using only the + custom interface. Users should not have to edit ~/.emacs themselves. + +- copy the file to elisp/emacs-goodies-el/ and add them to CVS. + + $ cvs add elisp/emacs-goodies-el/minibuf-electric.el + $ cvs commit -m "New files." elisp/emacs-goodies-el/minibuf-electric.el + +- When files are maintained by us, do it in CVS. + When files have an upstream maintainer, submit patches upstream. If not + responsive, handle them by creating a new "quilt" patch in debian/patches. + +- Make sure all interactive commands that are entry points into the file + have autoload cookies. + + (This following step is no longer done, as the emacs-goodies-loaddefs.el + file is generated at install time now: +# +# Update the `emacs-goodies-loaddefs.el' file by running: +# +# $ debian/rules patch +# $ cd elisp/emacs-goodies-el +# $ sh emacs-goodies-loaddefs.make +# $ cd - +# $ debian/rules unpatch + ) + +- Update `emacs-goodies-custom.el' by adding a modified copy of the file's + defgroup. Add lines for `:load' and a `:group 'emacs-goodies-el'. + +- Add whatever required startup and setup code that doesn't fit in the + above files to `emacs-goodies-el.el'. This gets loaded at Emacs startup. + +- Add documentation in alphabetical order to `emacs-goodies-el.texi' + Then from the Texinfo menu, invoke `Update Every Node' and + `Create Master Menu'. Then fill-in a description in the top menu for the + added entry. + + Test it: + + mkdir info + makeinfo emacs-goodies-el + info -f info/emacs-goodies-el + rm -fR info + +Debian Files +~~~~~~~~~~~~ + + README.Debian - add a short description of the new file. + + control - add a one-line file description. + + changelog - close the wishlist bug, if any. + + emacs-goodies-el.copyright - add a boxquote'd blurb for the file. + + emacs-goodies-el.emacsen-install.in - add exclusions for incompatible + flavors of Emacs. + + emacs-goodies-el.install - add a one-line entry to install the file + + +Testing the Package +~~~~~~~~~~~~~~~~~~~ + + $ ./make-orig.sh + $ cd ../build_25.1-1/emacs-goodies-el + $ fakeroot debian/rules binary + or + $ dpkg-buildpackage -rfakeroot + + +Releasing the package +~~~~~~~~~~~~~~~~~~~~~ + + - Set the distribution to "unstable" + - See "Testing the Package" to build. + - Tag the files in CVS, e.g. for version 25.1-1 : + + $ cvs tag debian_version_25_1-1 diff --git a/COPYING-GPL-v2 b/COPYING-GPL-v2 new file mode 100755 index 0000000..d511905 --- /dev/null +++ b/COPYING-GPL-v2 @@ -0,0 +1,339 @@ + 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 Lesser 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 + + 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) + + 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) year 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 Lesser General +Public License instead of this License. diff --git a/COPYING-GPL-v3 b/COPYING-GPL-v3 new file mode 100755 index 0000000..4432540 --- /dev/null +++ b/COPYING-GPL-v3 @@ -0,0 +1,676 @@ + + GNU GENERAL PUBLIC LICENSE + Version 3, 29 June 2007 + + Copyright (C) 2007 Free Software Foundation, Inc. + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The GNU General Public License is a free, copyleft license for +software and other kinds of works. + + The licenses for most software and other practical works are designed +to take away your freedom to share and change the works. By contrast, +the GNU General Public License is intended to guarantee your freedom to +share and change all versions of a program--to make sure it remains free +software for all its users. We, the Free Software Foundation, use the +GNU General Public License for most of our software; it applies also to +any other work released this way by its authors. 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 +them 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 prevent others from denying you +these rights or asking you to surrender the rights. Therefore, you have +certain responsibilities if you distribute copies of the software, or if +you modify it: responsibilities to respect the freedom of others. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must pass on to the recipients the same +freedoms that you received. 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. + + Developers that use the GNU GPL protect your rights with two steps: +(1) assert copyright on the software, and (2) offer you this License +giving you legal permission to copy, distribute and/or modify it. + + For the developers' and authors' protection, the GPL clearly explains +that there is no warranty for this free software. For both users' and +authors' sake, the GPL requires that modified versions be marked as +changed, so that their problems will not be attributed erroneously to +authors of previous versions. + + Some devices are designed to deny users access to install or run +modified versions of the software inside them, although the manufacturer +can do so. This is fundamentally incompatible with the aim of +protecting users' freedom to change the software. The systematic +pattern of such abuse occurs in the area of products for individuals to +use, which is precisely where it is most unacceptable. Therefore, we +have designed this version of the GPL to prohibit the practice for those +products. If such problems arise substantially in other domains, we +stand ready to extend this provision to those domains in future versions +of the GPL, as needed to protect the freedom of users. + + Finally, every program is threatened constantly by software patents. +States should not allow patents to restrict development and use of +software on general-purpose computers, but in those that do, we wish to +avoid the special danger that patents applied to a free program could +make it effectively proprietary. To prevent this, the GPL assures that +patents cannot be used to render the program non-free. + + The precise terms and conditions for copying, distribution and +modification follow. + + TERMS AND CONDITIONS + + 0. Definitions. + + "This License" refers to version 3 of the GNU General Public License. + + "Copyright" also means copyright-like laws that apply to other kinds of +works, such as semiconductor masks. + + "The Program" refers to any copyrightable work licensed under this +License. Each licensee is addressed as "you". "Licensees" and +"recipients" may be individuals or organizations. + + To "modify" a work means to copy from or adapt all or part of the work +in a fashion requiring copyright permission, other than the making of an +exact copy. The resulting work is called a "modified version" of the +earlier work or a work "based on" the earlier work. + + A "covered work" means either the unmodified Program or a work based +on the Program. + + To "propagate" a work means to do anything with it that, without +permission, would make you directly or secondarily liable for +infringement under applicable copyright law, except executing it on a +computer or modifying a private copy. Propagation includes copying, +distribution (with or without modification), making available to the +public, and in some countries other activities as well. + + To "convey" a work means any kind of propagation that enables other +parties to make or receive copies. Mere interaction with a user through +a computer network, with no transfer of a copy, is not conveying. + + An interactive user interface displays "Appropriate Legal Notices" +to the extent that it includes a convenient and prominently visible +feature that (1) displays an appropriate copyright notice, and (2) +tells the user that there is no warranty for the work (except to the +extent that warranties are provided), that licensees may convey the +work under this License, and how to view a copy of this License. If +the interface presents a list of user commands or options, such as a +menu, a prominent item in the list meets this criterion. + + 1. Source Code. + + The "source code" for a work means the preferred form of the work +for making modifications to it. "Object code" means any non-source +form of a work. + + A "Standard Interface" means an interface that either is an official +standard defined by a recognized standards body, or, in the case of +interfaces specified for a particular programming language, one that +is widely used among developers working in that language. + + The "System Libraries" of an executable work include anything, other +than the work as a whole, that (a) is included in the normal form of +packaging a Major Component, but which is not part of that Major +Component, and (b) serves only to enable use of the work with that +Major Component, or to implement a Standard Interface for which an +implementation is available to the public in source code form. A +"Major Component", in this context, means a major essential component +(kernel, window system, and so on) of the specific operating system +(if any) on which the executable work runs, or a compiler used to +produce the work, or an object code interpreter used to run it. + + The "Corresponding Source" for a work in object code form means all +the source code needed to generate, install, and (for an executable +work) run the object code and to modify the work, including scripts to +control those activities. However, it does not include the work's +System Libraries, or general-purpose tools or generally available free +programs which are used unmodified in performing those activities but +which are not part of the work. For example, Corresponding Source +includes interface definition files associated with source files for +the work, and the source code for shared libraries and dynamically +linked subprograms that the work is specifically designed to require, +such as by intimate data communication or control flow between those +subprograms and other parts of the work. + + The Corresponding Source need not include anything that users +can regenerate automatically from other parts of the Corresponding +Source. + + The Corresponding Source for a work in source code form is that +same work. + + 2. Basic Permissions. + + All rights granted under this License are granted for the term of +copyright on the Program, and are irrevocable provided the stated +conditions are met. This License explicitly affirms your unlimited +permission to run the unmodified Program. The output from running a +covered work is covered by this License only if the output, given its +content, constitutes a covered work. This License acknowledges your +rights of fair use or other equivalent, as provided by copyright law. + + You may make, run and propagate covered works that you do not +convey, without conditions so long as your license otherwise remains +in force. You may convey covered works to others for the sole purpose +of having them make modifications exclusively for you, or provide you +with facilities for running those works, provided that you comply with +the terms of this License in conveying all material for which you do +not control copyright. Those thus making or running the covered works +for you must do so exclusively on your behalf, under your direction +and control, on terms that prohibit them from making any copies of +your copyrighted material outside their relationship with you. + + Conveying under any other circumstances is permitted solely under +the conditions stated below. Sublicensing is not allowed; section 10 +makes it unnecessary. + + 3. Protecting Users' Legal Rights From Anti-Circumvention Law. + + No covered work shall be deemed part of an effective technological +measure under any applicable law fulfilling obligations under article +11 of the WIPO copyright treaty adopted on 20 December 1996, or +similar laws prohibiting or restricting circumvention of such +measures. + + When you convey a covered work, you waive any legal power to forbid +circumvention of technological measures to the extent such circumvention +is effected by exercising rights under this License with respect to +the covered work, and you disclaim any intention to limit operation or +modification of the work as a means of enforcing, against the work's +users, your or third parties' legal rights to forbid circumvention of +technological measures. + + 4. Conveying Verbatim Copies. + + You may convey 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; +keep intact all notices stating that this License and any +non-permissive terms added in accord with section 7 apply to the code; +keep intact all notices of the absence of any warranty; and give all +recipients a copy of this License along with the Program. + + You may charge any price or no price for each copy that you convey, +and you may offer support or warranty protection for a fee. + + 5. Conveying Modified Source Versions. + + You may convey a work based on the Program, or the modifications to +produce it from the Program, in the form of source code under the +terms of section 4, provided that you also meet all of these conditions: + + a) The work must carry prominent notices stating that you modified + it, and giving a relevant date. + + b) The work must carry prominent notices stating that it is + released under this License and any conditions added under section + 7. This requirement modifies the requirement in section 4 to + "keep intact all notices". + + c) You must license the entire work, as a whole, under this + License to anyone who comes into possession of a copy. This + License will therefore apply, along with any applicable section 7 + additional terms, to the whole of the work, and all its parts, + regardless of how they are packaged. This License gives no + permission to license the work in any other way, but it does not + invalidate such permission if you have separately received it. + + d) If the work has interactive user interfaces, each must display + Appropriate Legal Notices; however, if the Program has interactive + interfaces that do not display Appropriate Legal Notices, your + work need not make them do so. + + A compilation of a covered work with other separate and independent +works, which are not by their nature extensions of the covered work, +and which are not combined with it such as to form a larger program, +in or on a volume of a storage or distribution medium, is called an +"aggregate" if the compilation and its resulting copyright are not +used to limit the access or legal rights of the compilation's users +beyond what the individual works permit. Inclusion of a covered work +in an aggregate does not cause this License to apply to the other +parts of the aggregate. + + 6. Conveying Non-Source Forms. + + You may convey a covered work in object code form under the terms +of sections 4 and 5, provided that you also convey the +machine-readable Corresponding Source under the terms of this License, +in one of these ways: + + a) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by the + Corresponding Source fixed on a durable physical medium + customarily used for software interchange. + + b) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by a + written offer, valid for at least three years and valid for as + long as you offer spare parts or customer support for that product + model, to give anyone who possesses the object code either (1) a + copy of the Corresponding Source for all the software in the + product that is covered by this License, on a durable physical + medium customarily used for software interchange, for a price no + more than your reasonable cost of physically performing this + conveying of source, or (2) access to copy the + Corresponding Source from a network server at no charge. + + c) Convey individual copies of the object code with a copy of the + written offer to provide the Corresponding Source. This + alternative is allowed only occasionally and noncommercially, and + only if you received the object code with such an offer, in accord + with subsection 6b. + + d) Convey the object code by offering access from a designated + place (gratis or for a charge), and offer equivalent access to the + Corresponding Source in the same way through the same place at no + further charge. You need not require recipients to copy the + Corresponding Source along with the object code. If the place to + copy the object code is a network server, the Corresponding Source + may be on a different server (operated by you or a third party) + that supports equivalent copying facilities, provided you maintain + clear directions next to the object code saying where to find the + Corresponding Source. Regardless of what server hosts the + Corresponding Source, you remain obligated to ensure that it is + available for as long as needed to satisfy these requirements. + + e) Convey the object code using peer-to-peer transmission, provided + you inform other peers where the object code and Corresponding + Source of the work are being offered to the general public at no + charge under subsection 6d. + + A separable portion of the object code, whose source code is excluded +from the Corresponding Source as a System Library, need not be +included in conveying the object code work. + + A "User Product" is either (1) a "consumer product", which means any +tangible personal property which is normally used for personal, family, +or household purposes, or (2) anything designed or sold for incorporation +into a dwelling. In determining whether a product is a consumer product, +doubtful cases shall be resolved in favor of coverage. For a particular +product received by a particular user, "normally used" refers to a +typical or common use of that class of product, regardless of the status +of the particular user or of the way in which the particular user +actually uses, or expects or is expected to use, the product. A product +is a consumer product regardless of whether the product has substantial +commercial, industrial or non-consumer uses, unless such uses represent +the only significant mode of use of the product. + + "Installation Information" for a User Product means any methods, +procedures, authorization keys, or other information required to install +and execute modified versions of a covered work in that User Product from +a modified version of its Corresponding Source. The information must +suffice to ensure that the continued functioning of the modified object +code is in no case prevented or interfered with solely because +modification has been made. + + If you convey an object code work under this section in, or with, or +specifically for use in, a User Product, and the conveying occurs as +part of a transaction in which the right of possession and use of the +User Product is transferred to the recipient in perpetuity or for a +fixed term (regardless of how the transaction is characterized), the +Corresponding Source conveyed under this section must be accompanied +by the Installation Information. But this requirement does not apply +if neither you nor any third party retains the ability to install +modified object code on the User Product (for example, the work has +been installed in ROM). + + The requirement to provide Installation Information does not include a +requirement to continue to provide support service, warranty, or updates +for a work that has been modified or installed by the recipient, or for +the User Product in which it has been modified or installed. Access to a +network may be denied when the modification itself materially and +adversely affects the operation of the network or violates the rules and +protocols for communication across the network. + + Corresponding Source conveyed, and Installation Information provided, +in accord with this section must be in a format that is publicly +documented (and with an implementation available to the public in +source code form), and must require no special password or key for +unpacking, reading or copying. + + 7. Additional Terms. + + "Additional permissions" are terms that supplement the terms of this +License by making exceptions from one or more of its conditions. +Additional permissions that are applicable to the entire Program shall +be treated as though they were included in this License, to the extent +that they are valid under applicable law. If additional permissions +apply only to part of the Program, that part may be used separately +under those permissions, but the entire Program remains governed by +this License without regard to the additional permissions. + + When you convey a copy of a covered work, you may at your option +remove any additional permissions from that copy, or from any part of +it. (Additional permissions may be written to require their own +removal in certain cases when you modify the work.) You may place +additional permissions on material, added by you to a covered work, +for which you have or can give appropriate copyright permission. + + Notwithstanding any other provision of this License, for material you +add to a covered work, you may (if authorized by the copyright holders of +that material) supplement the terms of this License with terms: + + a) Disclaiming warranty or limiting liability differently from the + terms of sections 15 and 16 of this License; or + + b) Requiring preservation of specified reasonable legal notices or + author attributions in that material or in the Appropriate Legal + Notices displayed by works containing it; or + + c) Prohibiting misrepresentation of the origin of that material, or + requiring that modified versions of such material be marked in + reasonable ways as different from the original version; or + + d) Limiting the use for publicity purposes of names of licensors or + authors of the material; or + + e) Declining to grant rights under trademark law for use of some + trade names, trademarks, or service marks; or + + f) Requiring indemnification of licensors and authors of that + material by anyone who conveys the material (or modified versions of + it) with contractual assumptions of liability to the recipient, for + any liability that these contractual assumptions directly impose on + those licensors and authors. + + All other non-permissive additional terms are considered "further +restrictions" within the meaning of section 10. If the Program as you +received it, or any part of it, contains a notice stating that it is +governed by this License along with a term that is a further +restriction, you may remove that term. If a license document contains +a further restriction but permits relicensing or conveying under this +License, you may add to a covered work material governed by the terms +of that license document, provided that the further restriction does +not survive such relicensing or conveying. + + If you add terms to a covered work in accord with this section, you +must place, in the relevant source files, a statement of the +additional terms that apply to those files, or a notice indicating +where to find the applicable terms. + + Additional terms, permissive or non-permissive, may be stated in the +form of a separately written license, or stated as exceptions; +the above requirements apply either way. + + 8. Termination. + + You may not propagate or modify a covered work except as expressly +provided under this License. Any attempt otherwise to propagate or +modify it is void, and will automatically terminate your rights under +this License (including any patent licenses granted under the third +paragraph of section 11). + + However, if you cease all violation of this License, then your +license from a particular copyright holder is reinstated (a) +provisionally, unless and until the copyright holder explicitly and +finally terminates your license, and (b) permanently, if the copyright +holder fails to notify you of the violation by some reasonable means +prior to 60 days after the cessation. + + Moreover, your license from a particular copyright holder is +reinstated permanently if the copyright holder notifies you of the +violation by some reasonable means, this is the first time you have +received notice of violation of this License (for any work) from that +copyright holder, and you cure the violation prior to 30 days after +your receipt of the notice. + + Termination of your rights under this section does not terminate the +licenses of parties who have received copies or rights from you under +this License. If your rights have been terminated and not permanently +reinstated, you do not qualify to receive new licenses for the same +material under section 10. + + 9. Acceptance Not Required for Having Copies. + + You are not required to accept this License in order to receive or +run a copy of the Program. Ancillary propagation of a covered work +occurring solely as a consequence of using peer-to-peer transmission +to receive a copy likewise does not require acceptance. However, +nothing other than this License grants you permission to propagate or +modify any covered work. These actions infringe copyright if you do +not accept this License. Therefore, by modifying or propagating a +covered work, you indicate your acceptance of this License to do so. + + 10. Automatic Licensing of Downstream Recipients. + + Each time you convey a covered work, the recipient automatically +receives a license from the original licensors, to run, modify and +propagate that work, subject to this License. You are not responsible +for enforcing compliance by third parties with this License. + + An "entity transaction" is a transaction transferring control of an +organization, or substantially all assets of one, or subdividing an +organization, or merging organizations. If propagation of a covered +work results from an entity transaction, each party to that +transaction who receives a copy of the work also receives whatever +licenses to the work the party's predecessor in interest had or could +give under the previous paragraph, plus a right to possession of the +Corresponding Source of the work from the predecessor in interest, if +the predecessor has it or can get it with reasonable efforts. + + You may not impose any further restrictions on the exercise of the +rights granted or affirmed under this License. For example, you may +not impose a license fee, royalty, or other charge for exercise of +rights granted under this License, and you may not initiate litigation +(including a cross-claim or counterclaim in a lawsuit) alleging that +any patent claim is infringed by making, using, selling, offering for +sale, or importing the Program or any portion of it. + + 11. Patents. + + A "contributor" is a copyright holder who authorizes use under this +License of the Program or a work on which the Program is based. The +work thus licensed is called the contributor's "contributor version". + + A contributor's "essential patent claims" are all patent claims +owned or controlled by the contributor, whether already acquired or +hereafter acquired, that would be infringed by some manner, permitted +by this License, of making, using, or selling its contributor version, +but do not include claims that would be infringed only as a +consequence of further modification of the contributor version. For +purposes of this definition, "control" includes the right to grant +patent sublicenses in a manner consistent with the requirements of +this License. + + Each contributor grants you a non-exclusive, worldwide, royalty-free +patent license under the contributor's essential patent claims, to +make, use, sell, offer for sale, import and otherwise run, modify and +propagate the contents of its contributor version. + + In the following three paragraphs, a "patent license" is any express +agreement or commitment, however denominated, not to enforce a patent +(such as an express permission to practice a patent or covenant not to +sue for patent infringement). To "grant" such a patent license to a +party means to make such an agreement or commitment not to enforce a +patent against the party. + + If you convey a covered work, knowingly relying on a patent license, +and the Corresponding Source of the work is not available for anyone +to copy, free of charge and under the terms of this License, through a +publicly available network server or other readily accessible means, +then you must either (1) cause the Corresponding Source to be so +available, or (2) arrange to deprive yourself of the benefit of the +patent license for this particular work, or (3) arrange, in a manner +consistent with the requirements of this License, to extend the patent +license to downstream recipients. "Knowingly relying" means you have +actual knowledge that, but for the patent license, your conveying the +covered work in a country, or your recipient's use of the covered work +in a country, would infringe one or more identifiable patents in that +country that you have reason to believe are valid. + + If, pursuant to or in connection with a single transaction or +arrangement, you convey, or propagate by procuring conveyance of, a +covered work, and grant a patent license to some of the parties +receiving the covered work authorizing them to use, propagate, modify +or convey a specific copy of the covered work, then the patent license +you grant is automatically extended to all recipients of the covered +work and works based on it. + + A patent license is "discriminatory" if it does not include within +the scope of its coverage, prohibits the exercise of, or is +conditioned on the non-exercise of one or more of the rights that are +specifically granted under this License. You may not convey a covered +work if you are a party to an arrangement with a third party that is +in the business of distributing software, under which you make payment +to the third party based on the extent of your activity of conveying +the work, and under which the third party grants, to any of the +parties who would receive the covered work from you, a discriminatory +patent license (a) in connection with copies of the covered work +conveyed by you (or copies made from those copies), or (b) primarily +for and in connection with specific products or compilations that +contain the covered work, unless you entered into that arrangement, +or that patent license was granted, prior to 28 March 2007. + + Nothing in this License shall be construed as excluding or limiting +any implied license or other defenses to infringement that may +otherwise be available to you under applicable patent law. + + 12. No Surrender of Others' Freedom. + + If 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 convey a +covered work so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you may +not convey it at all. For example, if you agree to terms that obligate you +to collect a royalty for further conveying from those to whom you convey +the Program, the only way you could satisfy both those terms and this +License would be to refrain entirely from conveying the Program. + + 13. Use with the GNU Affero General Public License. + + Notwithstanding any other provision of this License, you have +permission to link or combine any covered work with a work licensed +under version 3 of the GNU Affero General Public License into a single +combined work, and to convey the resulting work. The terms of this +License will continue to apply to the part which is the covered work, +but the special requirements of the GNU Affero General Public License, +section 13, concerning interaction through a network will apply to the +combination as such. + + 14. Revised Versions of this License. + + The Free Software Foundation may publish revised and/or new versions of +the GNU 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 that a certain numbered version of the GNU General +Public License "or any later version" applies to it, you have the +option of following the terms and conditions either of that numbered +version or of any later version published by the Free Software +Foundation. If the Program does not specify a version number of the +GNU General Public License, you may choose any version ever published +by the Free Software Foundation. + + If the Program specifies that a proxy can decide which future +versions of the GNU General Public License can be used, that proxy's +public statement of acceptance of a version permanently authorizes you +to choose that version for the Program. + + Later license versions may give you additional or different +permissions. However, no additional obligations are imposed on any +author or copyright holder as a result of your choosing to follow a +later version. + + 15. Disclaimer of Warranty. + + 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. + + 16. Limitation of Liability. + + IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS +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. + + 17. Interpretation of Sections 15 and 16. + + If the disclaimer of warranty and limitation of liability provided +above cannot be given local legal effect according to their terms, +reviewing courts shall apply local law that most closely approximates +an absolute waiver of all civil liability in connection with the +Program, unless a warranty or assumption of liability accompanies a +copy of the Program in return for a fee. + + END OF TERMS AND CONDITIONS + + 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 +state the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + + Copyright (C) + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . + +Also add information on how to contact you by electronic and paper mail. + + If the program does terminal interaction, make it output a short +notice like this when it starts in an interactive mode: + + Copyright (C) + This program 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, your program's commands +might be different; for a GUI interface, you would use an "about box". + + You should also get your employer (if you work as a programmer) or school, +if any, to sign a "copyright disclaimer" for the program, if necessary. +For more information on this, and how to apply and follow the GNU GPL, see +. + + The GNU 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 Lesser General +Public License instead of this License. But first, please read +. + diff --git a/debian/README.Debian b/debian/README.Debian new file mode 100644 index 0000000..8df417b --- /dev/null +++ b/debian/README.Debian @@ -0,0 +1,310 @@ +Emacs Goodies for Debian +------------------------ + + The file you're currently reading is mostly meant as an introductory +starter for the various goodies included in emacs-goodies-el. Consult the +Info node `emacs-goodies-el' for more complete information. + + +Introduction to files in emacs-goodies-el +----------------------------------------- + +,----[ nice title ] +| boxquote.el allows the easy creation of boxes that look like this, +| with a nice title and all. Look for the M-x boxquote-* commands. +`---- + +align-string.el provides M-x align-string and M-x align-all-strings, +to align vertically the first occurences of a regexp over several +lines. + +all.el provides M-x all, a way to see all lines matching a regexp +pattern in a special buffer. Editing these lines in that buffer +propagates the changes back to the original buffer. + +apache-mode.el provides fontification when editing Apache configuration +files. + +ascii.el provides a way to display ASCII code on a window, that is, display +in another window an ASCII table highlighting the current character code. + +auto-fill-inhibit.el provides a finer grained control over +auto-fill-mode activation. Tu use it, simply load the file. For +instance, adding (load-library "auto-fill-inhibit") to your .emacs +should do the trick. You'll need to set the auto-fill-inhibit-list +variable to an appropriate value. + +bar-cursor.el allows you to change your cursor from a block to a +vertical bar in insert mode, and back to a block in overwrite mode. +Try M-x bar-cursor-mode. + +bm.el provides visible, buffer local, bookmarks and the ability to jump +forward and backward to the next bookmark. + +browse-huge-tar.el allows you to browse large tar files without reading +them into memory. The trade off is memory usage vs. speed. + +browse-kill-ring.el provides M-x browse-kill-ring.el, to, well, browse +through your kill ring, perform searches on it, and insert items into +a buffer. + +button-lock.el is a minor mode which provides simple facilities to +define clickable text based on regular expressions (used by maplev.el). + +cfengine.el is an Emacs major-mode for editing cfengine scripts. + +clipper.el provides the M-x clipper-* commands to save strings of data +and insert them afterwards. Each string is labeled with a name, and +can involve some basic template replacement. + +color-theme.el changes the colors used within Emacs. They are lots of +themes to choose from. + +csv-mode.el is a major mode for editing files of CSV type, which provides +commands, key bindings and a menu to sort records by field, kill and yank +columns, align and unalign fields, and transpose rows and columns. + +ctypes.el can search through source files hunting down typedefs. When +found, font-lock is informed and your source code will be even more +beautifully colored than before. + +coffee.el provides an Emacs interface to RFC2324-compliant coffee +devices + +dedicated.el allows you to toggle a window's "dedicated" flag. +When a window is "dedicated", Emacs will not select files into that window. + +df.el provides M-x df, to display in the mode line space left on +devices. + +diminish.el provides M-x diminish, M-x diminish-undo and M-x +diminished-modes. Diminished modes are minor modes with a shorter or +no modeline display. + +dir-locals.el provides a functionality similar to the local variables +defined in a file, but for an entire directory tree. Use This library +implements such a scheme, controlled by the global minor mode +`dir-locals-mode'. + +edit-env.el lets you display, edit, delete and add environment variables. + +egocentric.el provides M-x egocentric-mode, a mode to highlight your +name (or other keywords) in buffers. If you use Gnus, you might want +to add (add-hook 'gnus-article-prepare-hook 'egocentric-mode) to your +Gnus init file. + +eproject.el is an extension that lets you group related files together as +projects. It aims to be as unobtrusive as possible -- no new files are +created (or required to exist) on disk, and buffers that aren't a member of +a project are not affected in any way. + +ff-paths.el allows you to use C-x C-f normally most of the time, +except that if the requested file doesn't exist, it is checked against +a list of patterns for special paths to search for a file of the same +name. Use (require 'ff-paths) in your .emacs to activate it. + +filladapt.el enhances the behavior of Emacs's fill functions by +guessing the proper fill prefix in many contexts. Emacs has a +built-in adaptive fill mode but Filladapt is said to be much better. +Use `M-x filladapt-mode' to toggle Filladapt mode on/off in the current +buffer. Use 'turn-on-filladapt-mode in mode hooks. + +folding.el provides a minor mode for folding (hiding) parts of the edited +text or program. Folding mode handles a document as a tree, where each +branch is bounded by special markers `{{{' and `}}}'. + +framepop.el makes temporary buffers such as *Help* or *Completions* appear +in a separate frame which is easily dismissed when no longer needed. + +floatbg.el provides M-x floatbg-mode, to slowly modify the background +color of your Emacs. + +graphviz-dot-mode.el provides a mode for editing files in the dot-language +(www.graphviz.org and http://www.research.att.com/sw/tools/graphviz/). + +highlight-beyond-fill-column.el highlights (with a face you choose) text +that is beyond the fill-column, therefore providing a visual indication of +where the fill-* functions would wrap the lines. Enable it on a buffer +using `M-x highlight-beyond-fill-column.' You may use that command in a +hook (e.g. text-mode-hook) + +highlight-current-line.el highlights the line the cursor is in. Enable a +buffer using the command `M-x highlight-current-line-minor-mode'. You may +enable the minor-mode automatically for (almost) all buffers by + +home-end.el provides some useful bindings for Home and End keys: hit the +key once to go to the beginning/end of a line, hit it twice in a row to go +to the beginning/end of the window, three times in a row goes to the +beiginning/end of the buffer. To enable it, customize the variable +`home-end-enable'. + +htmlize.el provides many M-x htmlize-* commands that turn files, +buffers, or region of font-lock colorised text into an HTML +representation. + +initsplit.el allows you to split Emacs customizations (set via M-x +customize) into different files, based on the names of the variables. +To use it, just load the file in your .emacs: (load "initsplit"). +Note that that you *must* load each file that contains your various +customizations from your .emacs. + +joc-toggle-buffer.el provides M-x joc-toggle-buffer, a command that can be +bound to a key in order to speed up the switching between two buffers. + +joc-toggle-case.el provides a sophisticated (over-engineered?) set of +functions to toggle the case of the character under point, with which +you can emulate vi's ~ function. Look for the M-x joc-toggle-case and +M-x joc-toggle-case-* commands. + +keydef.el provides the `keydef' macro for use in .emacs files (or +similar). It is an alternative (simpler) way to define keys, with kbd +syntax. You should read the doc in keydef.el, as it is not intended +for interactive use. + +keywiz.el drills you about Emacs key-bindings. You're presented with +the name of a command and the docstring, and then prompted for the +correct key sequence. You'll earn one point for each correct answer +during the time limit. Invoke with `M-x keywiz'. + +lcomp.el adds useful keybindings to the completions buffer. + +maplev.el is a major mode for Maple. + +map-lines.el provides M-x map-lines, a command to iterate a given +command over lines matching a regexp. + +marker-visit.el provides a simple way to navigate among marks in a buffer. +All the marks you've left while editing a buffer serve as bread crumb +trails of areas in the buffer you've edited. It is convenient to navigate +back and forth among these marks in order. This file provides two methods +to do just that, marker-visit-prev and marker-visit-next to visit the +nearest mark in either direction. + +matlab.el provides support for editing MATLAB dot-m files. It +automatically indents for block structures, line continuations (e.g., ...), +and comments. + +minibuf-electric.el eases minibuffer typing. When you type "//", it clears +the minibuffer back to the start, leaving only a single "/". When you type +a "~", it does the similar, leaving only "~/". This is nicer than having +to explicitly erase the contents of the minibuffer. + +minibuffer-complete-cycle.el makes `minibuffer-complete' select each of the +possible completions in turn, inserting it into the minibuffer and +highlighting it in the *Completions* buffer. + +miniedit.el toggles minibuffer editing into a full text-mode buffer for +easy multi-line editing of commands. + +mutt-alias.el provides M-x mutt-alias-insert and M-x +mutt-alias-lookup, two commands to lookup and insert the expansion of +mutt mail aliases. + +muttrc-mode.el provides muttrc-mode, a major mode to help the edition +of Mutt configuration files. To use it, either open a file named +muttrc, or add a local variables section to the end of your file to +specify the mode to be "muttrc". + +obfusurl.el provides M-x obfuscate-url, a command that will obfuscate +an URL under the cursor. + +pack-windows.el resizes all windows vertically to display as much +information as possible with the command `M-x pack-windows'. + +perldoc.el provides an interface to the "perldoc" command in your +Perl-mode or CPerl-mode buffers. Use (require 'perldoc) in your +.emacs to activate it, then place point over a word and press F1. + +pp-c-l displays Control-l characters in a pretty way. + +pod-mode.el provides support for editing Plain Old Documentation +(Perl documentation) files. It provides syntax highlighting. + +projects.el provides M-x add-project, remove-project and +list-projects, and introduces the concept of PROJECT ROOTS that allow +the user to define logical project names and get abbreviated yet +meaningful buffer names in the modeline. + +protbuf.el provides M-x protect-buffer-from-kill-mode and M-x +protect-process-buffer-from-kill-mode, two commands to protect buffers +from being accidentally killed. + +protocols.el provides M-x protocols-lookup, to search for info in your +/etc/protocols. + +quack.el provides enhanced support for editing and running Scheme code +in both the major and minor modes. It also provides easy access to online +references for plt-scheme, books on Scheme, and SRFIs (Scheme Requests +For Implementation). Because it invasively changes scheme-mode, it is +not enabled by default. To enable it, customize the variable `quack-install'. + +rfcview.el formats IETF RFCs for improved readability. + +services.el provides M-x services-lookup, to search for info in your +/etc/services. + +session.el restores various variables (e.g., input histories) from your +last session. It also provides a menu containing recently changed/visited +files and restores the places (e.g., point) of such a file when you revisit +it. + +setnu.el provides M-x setnu-mode, a vi-style line number mode. + +shell-command.el is an an enhancement for shell-command, enabling +tab-completion of commands and dir/filenames within the shell-command input +context. + +show-wspace.el is a minor mode to highlight whitespaces of various kinds. + +slang-mode.el is a major mode for editing S-Lang files. + +silly-mail.el provides M-x add-sm-* commands to add various headers to +your email messages. + +sys-apropos.el provides M-x sys-apropos, an interface to the "apropos" +command. + +tabbar.el displays buffers as tabs in the header line, and provides commands +to switch between them. You can bind keys to M-x tabbar-forward and M-x +tabbar-backward, and use these to quickly switch between buffers. By default, +tabbar-mode will group buffers into various groups, and only display one group +at a time on the tabbar; you can change this by customizing tabbar. + +tail.el provides the commands M-x tail-file and M-x tail-command, to +follow the output of a command (or to follow a log file) without using +any terminals. + +tc.el provides a nice way to quote cited texts, with proper filling +and attribution. You can use it for instance by setting the cite +function to 'trivial-cite: (setq message-cite-function 'trivial-cite). + +thinks.el provides cartoon-like think bubbles . o O ( like this ). +Look for M-x thinks* commands. + +tlc.el is a major mode for editing Target Language Compiler scripts. It +automatically indents the programming constructs. + +tld.el provides M-x tld, for easy access to all those top-level +domains you just can't remember, and to the corresponding countries. + +todoo.el provides M-x todoo and M-x todoo-mode, to conveniently edit +TODO lists. + +toggle-option.el provides M-x toggle-option, a command to rapidly +toggle an option. You should set the toggle-option-list variable to +an appropriate value. + +twiddle.el provides mode-line hacks. There are two user commands of +interest: twiddle-start and twiddle-compile. + +under.el provides M-x underline-region, to underline a bit of text +with ^ characters like this. + ^^^^^^^^^ +upstart-mode.el is a major-mode for editing .upstart files. + +xrdb-mode.el provides the xrdb-mode major mode, to help you editing X +resource database files. To use it, simple open a file named .Xdefaults, +.Xenvironment, .Xresources or *.ad after having enabled it by customising +`xrdb-mode-setup-auto-mode-alist'. + + -- Peter S Galbraith , Sun, 6 Nov 2016 14:50:31 -0500 diff --git a/debian/README.source b/debian/README.source new file mode 100644 index 0000000..cf9481f --- /dev/null +++ b/debian/README.source @@ -0,0 +1,17 @@ +This package uses quilt to manage all modifications. See + + /usr/share/doc/quilt/quilt.pdf.gz + +to get more information on how to use it. + +To apply and unapply all patches, you can run: + + quilt push -a + quilt pop -a + +ensuring that you have set QUILT_PATCHES=debian/patches, or alternatively + + debian/rules patch + debian/rules unpatch + + -- Julian Gilbey , Sun, 2 Feb 2014 14:53:29 +0000 diff --git a/debian/changelog b/debian/changelog new file mode 100644 index 0000000..7c286e8 --- /dev/null +++ b/debian/changelog @@ -0,0 +1,3083 @@ +emacs-goodies-el (36.3) unstable; urgency=high + + * emacs-goodies-el: + - Bug fix: "fails to upgrade/install", thanks to Brent S. Elmer + (Closes: #845216). Skip byte-compilation for minibuffer-complete-cycle.el on + emacs23. + + -- Peter S Galbraith Mon, 21 Nov 2016 15:20:03 -0500 + +emacs-goodies-el (36.2) unstable; urgency=medium + + * Bug fix: "partially incompatible with xemacs21", thanks to Aaron + M. Ucko (Closes: #844176). + + -- Peter S Galbraith Mon, 14 Nov 2016 10:04:16 -0500 + +emacs-goodies-el (36.1) unstable; urgency=medium + + * dpkg-dev-el: + - debian-changelog-mode.el tweak bug fix #803767. Thanks to + Vincent Bernat fo the heads up. + * emacs-goodies-el: + - tc.el bug fix: "tc.el (and other packages perhaps): save-excursion has + changed in emacs25 to save-mark-and-excursion", thanks to + Gijs Hillenius (Closes: #841059). + + -- Peter S Galbraith Tue, 08 Nov 2016 09:25:46 -0500 + +emacs-goodies-el (36.0) unstable; urgency=medium + + * Bug fix: "site-start files don't work", thanks to Samuel Bronson + (Closes: #751201). Added "emacsen-common (>= 2.0.8)" to all packages. + * emacs-goodies-el: + - markdown.el removed; use elpa-markdown-mode instead. + (Closes: #644903, #656868, #810035) + - dict.el removed; use dictionary-el instead. + (Closes: #840763, #611919, #718028) + - apache.el updated to 2015-08-23 version 2.0 + - minibuffer-complete-cycle.el updated to 1.25.20130814 + - quack.el updated to 0.48 + - minibuf-electric.el bug fix: "[patch] fix minibuf-electric.el for + emacs24", thanks to Karl Hegbloom (Closes: #803728). + - rfcview.el bug fix: "rfcview.el does not obey fill-column", thanks to + frozencemetery (Closes: #761139). + * Bug fix: "cyclebuffer busted", thanks to jidanni@jidanni.org; + (Closes: #613063). + * dpkg-dev-el: + - debian-changelog-mode.el bug fix: "don't rely on external date + (LP#1197870)", thanks to era eriksson and Pierre Carrier + (Closes: #803767). + - debian-changelog-mode.el bug fix: "highlight backports", thanks to + Kumar Appaiah (Closes: #708317). + + -- Peter S Galbraith Sun, 06 Nov 2016 14:47:29 -0500 + +emacs-goodies-el (35.13) unstable; urgency=medium + + * debian-el: + - Bug fix: "Missing ; in debian-bug.el first line header", thanks + to Antoine R. Dumont (Closes: #842566). + - Bug fix: "apt-sources.el duplicate auto-mode-alist sources.list", + thanks to Kevin Ryde (Closes: #712835). + * Bug fix: "apt-sources.el: Distribution names are out of date", thanks + to Memnon Anon (Closes: #705281). + * Bug fix: "should depend on xz-utils", thanks to Sven Joachim + (Closes: #638202). + * Bug fix: "gnus-BTS.el search for bugs against wrong url", thanks to + Marco Bardelli (Closes: #756208). + * Bug fix: "apt-utils.el should use word-at-point for default value for + package", thanks to Remi Vanicat (Closes: #613776). + * Bug fix: "please add all BTS commands (e.g. affects and usertags)", + thanks to Luca Capello (Closes: #643888). + * Bug fix: "improve handling of {old-, }stable-proposed-updates", thanks + to Guido Gunther (Closes: #818010). + * emacs-goodies-el: + - maplev.el update to 2.27 + - button-lock.el: new file needed by maplev.el + + -- Peter S Galbraith Sun, 06 Nov 2016 10:28:29 -0500 + +emacs-goodies-el (35.12) unstable; urgency=medium + + * Bug fix: "please switch to emacs24", thanks to Gabriele Giacone + (Closes: #754007). + + -- Peter S Galbraith Mon, 07 Jul 2014 17:47:33 -0400 + +emacs-goodies-el (35.11) unstable; urgency=medium + + * Complete dpatch -> quilt transition from 31.7 by removing dpatch code + from debian/patch/* files + * Quieten lintian warnings by removing executable bits from almost all + files + * Include make-orig.sh in source distribution (cvs-buildpackage does + this anyway) + * vm-bonus-el package removed - it's ancient and barely used anymore + * Remove gnus-bonus-el from the source package (the binary package was + removed in 35.6). This closes the bugs against it, even though they + have not been fixed (Closes: #570276, #448441, #236919, #597035, + #609698, #648607) + * Fix piuparts error with a temporary patch, until emacsen-common (or + whatever the true source of the bug is) is fixed. (Closes: #737202) + * Add emacsen compat files (in line with new policy and current + debhelper behaviour) + * Rewrite rules to use nice debhelper stuff; have explicity quilt + build-dependency + * Rewrite copyright files to use DEP-5/copyright-format-1.0 + * Update Standards-Version + + -- Julian Gilbey Mon, 03 Feb 2014 00:02:53 +0000 + +emacs-goodies-el (35.10) unstable; urgency=medium + + * Bug fix: "M-x debian-bug does not run bug script if it is a symlink", + thanks to Sven Joachim for the patch and sorry for the long delay + (Closes: #679390) + + -- Peter S Galbraith Thu, 30 Jan 2014 08:04:10 -0500 + +emacs-goodies-el (35.9) unstable; urgency=medium + + * dpkg-dev-el + - debian-changelog-mode.el Bug fix: "default urgency to medium", thanks + to Jonathan Wiltshire (Closes: #731105). + * Bug fix: "fails to upgrade lenny -> squeeze -> wheezy -> + jessie", thanks to Andreas Beckmann (Closes: #730066, #730069). Skip + byte-compilation of markdown-mode.el for obsolete emacs22. I am + surprsied that the lack of handling of such old versions gets a + package kicked out of testing! + + -- Peter S Galbraith Mon, 30 Dec 2013 13:46:55 -0500 + +emacs-goodies-el (35.8) unstable; urgency=low + + * vm-bonus-el: + - Bug fix: "fails to install: ERROR: install script from vm-bonus-el + package failed", thanks to Andreas Beckmann (Closes: #706746). Drop + the addition of /usr/share/emacs/site-lisp/vm to the compilation + load-path. + + -- Peter S Galbraith Fri, 18 Oct 2013 20:01:49 -0400 + +emacs-goodies-el (35.7) unstable; urgency=low + + * vm-bonus-el: + - Bug fix: "fails to install: ERROR: install script from vm-bonus-el + package failed", thanks to Andreas Beckmann (Closes: #706746). Can't + builf vm-bonus-el using "-q -no-site-file" because we need to load vm + correctly. + + -- Peter S Galbraith Thu, 17 Oct 2013 12:33:18 -0400 + +emacs-goodies-el (35.6) unstable; urgency=low + + * emacs-goodies-el: + - Update to latest available version: + ascii.el + folding.el + matlab.el + minibuffer-complete-cycle.el (not updated; compilation errors) + rfcview.el + * vm-bonus-el + - Bug fix: "fails to install: ERROR: install script from vm-bonus-el + package failed", thanks to Andreas Beckmann (Closes: #706746, 709962). + * gnus-bonus-el binary package removed. I don't use it and several + people have offered to take it up in the past and never have. + + -- Peter S Galbraith Tue, 15 Oct 2013 15:23:33 -0400 + +emacs-goodies-el (35.5) unstable; urgency=low + + * emacs-goodies-el: + - Bug fix: "quack.el is out of date, upgrade to latest.", thanks to + Mehul Sanghvi (Closes: #720890). + - Bug fix: "tlc.el auto-mode-alist dot form", thanks to Kevin Ryde + (Closes: #699389). + - Bug fix: "please update markdown-mode", thanks to + yoh@onerussian.com; (Closes: #695299). + * dpkg-dev-el: + - Bug fix: "Unable to add field "DM-Upload-Allowed", thanks to Kan-Ru + Chen (Closes: #652424). + + -- Peter S Galbraith Tue, 15 Oct 2013 13:43:58 -0400 + +emacs-goodies-el (35.4) unstable; urgency=low + + * Bug fix: emacsen-install.template: "fails to install due to heredoc + failing; lazy evaluation and parentheses the culprit?", thanks to + Daniel Dickinson (Closes: #701952). + + -- Peter S Galbraith Sun, 03 Mar 2013 12:28:13 -0500 + +emacs-goodies-el (35.3) unstable; urgency=low + + * Bug fix: "egocentric.el and emacs24: "make-local-hook" is obsolete", + thanks to Paul. Changed in ascii.el, egocentric.el, maplev.el via + quilt patch 56_make_local_hook.diff. (Closes: #692750) + * Bug fix: "wrong "Vcs-Cvs"; field value => debcheckout doesn't", thanks + to Samuel Bronson. Edited debian/control as proposed (Closes: #691987). + * Bug fix: "Improve muttrc auto-mode pattern", thanks to Rafael + Laboissiere. Patch applied to emacs-goodies-el.el (Closes: #645591). + * Bug fix: "tlc mode's auto-mode-alist pattern should end \\'; not $", + thanks to Reuben Thomas. Fixed without a quilt patch since I had + already edited that file (Closes: #616166). + + -- Peter S Galbraith Fri, 25 Jan 2013 13:43:51 -0500 + +emacs-goodies-el (35.2+nmu1) unstable; urgency=low + + * Non-maintainer upload. + * No longer create /root/.gnupg during installation of gnus-bonus-el. + This is achieved by binding epg-gpg-home-directory to a temporary + directory during bytecode compilation (implementation in + debian/emacsen-install.template). (Closes: #689807) + + -- Sébastien Villemot Sun, 21 Oct 2012 11:30:47 +0200 + +emacs-goodies-el (35.2) unstable; urgency=low + + [ Roland Mas ] + * dpkg-dev-el: + - debian-changelog-mode.el: Allow customization of allowed distributions + (Closes: #645303). + + -- Peter S Galbraith Thu, 27 Oct 2011 13:30:01 -0400 + +emacs-goodies-el (35.1) unstable; urgency=low + + * emacs-goodies-el: + - Bug fix: "cwebm still included in package description", thanks to era + eriksson (Closes: #541348). + * Bug fix: "wdired still mentioned in package description", thanks to + Sven Joachim (Closes: #598888). + - ff-paths.el: "Typo in ff-paths.el", thanks to Reuben Thomas (Closes: + #609169). + - markdown-mode.el: "New upstream version of markdown-mode.el + available", thanks to Jason Blevins (Closes: #637709). + - pod-mode.el: Skip byte-compilation for emacs21, thanks to Bob Proulx + (Closes: #635667). + * debian-el: + - deb-view.el: "deb-view does not support xz-compressed debs", thanks to + Sven Joachim (Closes: #637579). + * dpkg-dev-el: + - debian-control-mode.el: "please Add support for Multi-Arch field in + debian-control-mode.el", thanks to Andreas Rottmann (Closes: #634162). + + -- Peter S Galbraith Tue, 16 Aug 2011 23:21:02 -0400 + +emacs-goodies-el (35.0) unstable; urgency=low + + * emacs-goodies-el: + New files: + - eproject.el: assign files to projects, programatically. + Thanks to Florian Ragwitz (Closes: #585044). + * dpkg-dev-el: + - debian-control-mode.el: Added "XS-Python-Version" to + debian-control-source-fields, thanks to Cedric Delfosse (Closes: #591697) + + -- Peter S Galbraith Sat, 25 Jun 2011 15:47:16 -0400 + +emacs-goodies-el (34.2) unstable; urgency=low + + * emacs-goodies-el: + - session.el updated to V2.3, thanks to Christoph Wedler. + - graphviz-dot-mode.el updated to V0.3.6, thanks to Pander. + - home-end.el, new upstream version. "home-end-home and home-end-end get + confused inside keyboard macros", thanks to Dima Kogan + (Closes: #614327). + - maplev.texi: Updated from http://www.mapleprimes.com/files/84_maplev.zip + and added (without patching) "@dircategory Emacs", thanks to + Christophe Jarry (Closes: #609677). + * debian-el: + - apt-utils-el: Bug fix: "Apt-util.el doesn't know about + Description-fr", thanks to Remi Vanicat (Closes: #613778). + Patch applied without consulting Matt; Hope that's okay! + + -- Peter S Galbraith Fri, 24 Jun 2011 12:37:31 -0400 + +emacs-goodies-el (34.1) unstable; urgency=low + + * debian/control: + - Standards-Version: 3.9.0 + * gnus-bonus-el: + - No longer depend on recent version of Emacs or gnus. + Bug fix: "please allow emacs-snapshot as an alternative emacs", + thanks to RISKO Gergely (Closes: #587321). + * emacs-goodies-el: + - perldoc.el: Complete for Perl core documentation. + Thanks to Florian Ragwitz for the bug report. + (Closes: #589785) + - pod-mode.el: New upstream release available 1.03. Thanks to + Florian Ragwitz for the bug report (Closes: #589434). + - tail.el: "tail.el restart timer on new output", thanks to Kevin Ryde + (Closes: #584598). + * dpkg-dev-el: + - debian-copyright.el: Fix and simplify auto-mode-alist", thanks to + Kevin Ryde (Closes: #587922). + - debian-changelog.el: Simplify auto-mode-alist, thanks to Kevin Ryde + (Closes: #587924) + - dpkg-dev-el.el: Fix modify-coding-system-alist entry for utf-8, + thanks to Kevin Ryde (Closes: #587921) + + -- Peter S Galbraith Wed, 28 Jul 2010 11:50:25 -0400 + +emacs-goodies-el (34.0) unstable; urgency=low + + [ Peter S Galbraith ] + * emacs-goodies-el: + New files: + - upstart-mode.el: major-mode to edit .upstart files. + Thanks to Stig Sandbeck Mathisen (Closes: #586321). + - graphviz-dot-mode.el: Mode for the dot-language used by graphviz (att). + Thanks to Riccardo Vestrini (Closes: #428601). + + [ Matt Hodges ] + * debian-el: + - apt-utils-el: Bug fix: "When returning to the package list, it's not + sorted anymore", thanks to Remi Vanicat (Closes: #568419). + + -- Peter S Galbraith Sun, 27 Jun 2010 22:05:01 -0400 + +emacs-goodies-el (33.6) unstable; urgency=low + + * debian-el: + - debian-bug.el: Updated `debian-bug-pseudo-packages'. + * emacs-goodies-el: + - pod-mode.el: New upstream version 1.01, thanks to Florian Ragwitz + (Closes: #585044). + - emacs-goodies-el.texi: Improvement to info docs of + auto-fill-inhibit.el, thanks to Kevin Ryde for the patch (Closes: #584970). + + -- Peter S Galbraith Mon, 21 Jun 2010 19:09:33 -0400 + +emacs-goodies-el (33.5) unstable; urgency=low + + * debian-el: + - debian-bug.el: + Support "Bugs:" control field for unofficial packages". + Thanks to Håkon Stordahl for the massive patch! + (Closes: #222392). + * dpkg-dev-el: + - debian-changelog-mode.el + Bug fix: "debian-changelog-date-utc-flag custom group", thanks to + Kevin Ryde (Closes: #580818). Fixed typo. + + -- Peter S Galbraith Tue, 11 May 2010 21:46:40 -0400 + +emacs-goodies-el (33.4) unstable; urgency=low + + * emacs-goodies-el: + - bm.el: New upstream version 1.43, thanks to Maindoor + + - color-theme.el: + Bug fix: "color-theme: replace-in-string breaks other packages", + thanks to intrigeri@boum.org; (Closes: #580213). Applied patch from + upstream CVS directly without a quilt patch because future upstream + version won't need such a patch. + * debian-el: + - debian-bug.el: + Bug fix: "M-x debian-bug no longer runs bug scripts, generates useless + reports", thanks to Sven Joachim for the report (Closes: #579861). + Bug fix: "please, include the output of /usr/shar/bug/...", thanks to + Jiří Paleček for the request and to Håkon Stordahl + for the massive patch ! (Closes: #422506). + This should also fix "bad interaction with reportbug", thanks to Johan + Kullstam for reporting, and please reopen the bug if not fixed + (Closes: #541729). + * dpkg-dev-el: + - debian-control-mode.el: Bug fix: "Breaks:" fields in control files is + not recognized", thanks to Hilko Bengen (Closes: #580501). + + -- Peter S Galbraith Fri, 07 May 2010 18:24:55 -0400 + +emacs-goodies-el (33.3) unstable; urgency=low + + * emacs-goodies-el: + Bug fix: "color-theme doesn't initialize correctly", thanks to Daniele + Giglio (Closes: #578619). Fixed documentation in Info. + * debian-el: + - debian-bug.el: Bug fix: "stty fails with 'inappropriate ioctl for + device'", thanks to Sanjoy Mahajan for the report and to H. Stordahl + for the solution that has added to reportbug: As of version 4.12 + reportbug has a --no-bug-script option (Closes: #502317). + + -- Peter S Galbraith Wed, 28 Apr 2010 17:44:35 -0400 + +emacs-goodies-el (33.2) unstable; urgency=low + + * emacs-goodies-el: + - pp-c-l.eL: Skip installing for XEmacs, thanks to Kevin Ryde + (Closes: #577596). + * dpkg-dev-el: + - debian-changelog-mode.el: Invoke `debian-bug-build-bug-menu' with + SOURCE arg set to t. Needs debian-el 33.2 + * debian-el: + - debian-bug.el: `debian-bug-build-bug-menu' now takes optional SOURCE + argument. Fixes "Empty bug list", thanks to Remi Vanicat (Closes: #579394). + + -- Peter S Galbraith Tue, 27 Apr 2010 23:39:40 -0400 + +emacs-goodies-el (33.1) unstable; urgency=low + + * emacs-goodies-el: + V33.0 got away without the _actual_ dirvals.el to dir-locals.el + transition actually done because of a CVS mistake. + + -- Peter S Galbraith Fri, 09 Apr 2010 22:07:16 -0400 + +emacs-goodies-el (33.0) unstable; urgency=low + + * emacs-goodies-el: + New files: + - pp-c-l.el --- Display Control-l characters in a pretty way. + Thanks to Andrey Paramonov for the suggestion (Closes: #524081). + - dir-locals.el -- Local variables for a directory tree + Removed file: + - dirvals.el, replaced with dir-locals.el. Thanks to Dave Love + (Closes: #377676). + New upstream version: + - egocentric.el. Patch from Ubuntun bug #109132 applied for + customization mismatches. + - xrdb-mode.el V3.0. Bug fix: "xrdb-mode docstring show keymap", + thanks to Kevin Ryde (Closes: #559514). Apologies to Barry Warsaw + since this version was ready last December. + + -- Peter S Galbraith Fri, 09 Apr 2010 21:33:48 -0400 + +emacs-goodies-el (32.0) unstable; urgency=low + + * emacs-goodies-el: + New files: + - miniedit.el --- Enhanced editing for minibuffer fields. + Thanks to Joerg Jaspert for the suggestion (Closes: #514519). + - bm.el --- Visible bookmarks in buffers. + Thanks to Boris Daix for the suggestion (Closes: #353982). + Bug fixes: + - ctypes.el: Added a require for cc-mode in order to use its font-lock + faces. Should close Unbuntu bug #162954. + - color-theme_seldefcustom.el: New file to hold `color-theme' selection + customization to avoid loading color-theme on startup even for those + who don't use it. + + -- Peter S Galbraith Wed, 07 Apr 2010 14:14:23 -0400 + +emacs-goodies-el (31.8) unstable; urgency=low + + * emacs-goodies-el: + - map-lines.el: New upstream version by new maintainer Paul Hobbs. + - perldoc.el: New upstream version by Ben Voui, fixes "perldoc.el in + buffer with non-existent current directory", thanks to Kevin Ryde + (Closes: #574650). + - color-theme: "Please update to color-theme 6.6", thanks to Douglas Calvert + (Closes: #573059). Now comes in two files: color-theme.el and + color-theme-library.el, which was added to the package. Upstream uses + a subdirectory for it, but I opted not-to for simplicity. I did have + to patch it a bit to look for "color-theme-*" files instead of + "color-theme*" files for that reason. + + -- Peter S Galbraith Tue, 06 Apr 2010 16:59:33 -0400 + +emacs-goodies-el (31.7) unstable; urgency=low + + * Migrate source patching from dpatch to quilt. + * Migrate to source package format "3.0 (native)". + * emacs-goodies-el: + - cyclebuffer.el: removed since users can now do that using "C-x C-left" + and "C-x C-right", thanks to jidanni@jidanni.org (Closes: #476497). + - maplines.el: New upstream version by new maintainer Paul Hobbs. + + -- Peter S Galbraith Mon, 05 Apr 2010 16:01:56 -0400 + +emacs-goodies-el (31.6) unstable; urgency=low + + [ Peter S Galbraith ] + * emacs-goodies-el: The following files were removed because they are + included in Emacs-23: + cua.el + cfengine.el + ibuffer.el + ido.el + newsticker.el + nuke-trailing-whitespace.el + table.el + wdired.el + - perldoc.el: New upstream version by Ben Voui, fixes "perldoc.el + incomplete module cache if interrupted" reported by Kevin Ryde + (Closes: #575455). + + [ Junichi Uekawa ] + * dpkg-dev-el: + - readme-debian.el: Bug fix: "README.Debian date wrong in XEmacs", + thanks to Russ Allbery (Closes: #364234). + + -- Peter S Galbraith Thu, 01 Apr 2010 15:58:42 -0400 + +emacs-goodies-el (31.5) unstable; urgency=low + + * emacs-goodies-el: + - lcomp.el: New upstream version (Closes: #551827). + - emacs-goodies-el.el :Replace $ by \\' in auto-mode-alist entries, + thanks to Kevin Ryde (Closes: #570293). + * dpkg-dev-el: + - debian-bts-control.el: Bug fix: "emacs-bts-control command should be + autoloaded", thanks to Sven Joachim (Closes: #565934). + + -- Peter S Galbraith Mon, 22 Feb 2010 20:53:01 -0500 + +emacs-goodies-el (31.4) unstable; urgency=low + + * emacs-goodies-el: + - Bug fix: "xemacs21 empty emacs-goodies-loaddefs.el", thanks to Kevin + Ryde (Closes: #563853). + + -- Peter S Galbraith Wed, 06 Jan 2010 22:17:10 -0500 + +emacs-goodies-el (31.3) unstable; urgency=low + + * emacs-goodies-el: + - maplev.texi: "the maplev info file contain incorect + START-INFO-DIR-ENTRY entry", thanks to R. Vanicat (Closes: #559557). + I had two fixes; one on matlev.texi in CVS and one as a dpatch. + * debian-el: + - debian-bug.el: Emacs BTS moved to debbugs.gnu.org + * dpkg-dev-el: + - debian-bts-control.el: Emacs BTS moved to debbugs.gnu.org + Thanks to Sven Joachim (Closes: #561561). + * Debian native version number: Package tar ball now includes debian + directory, previously distributed in the diff.gz file. This allows + the copyright and patches to be distributed together as the package is + now repackaged and distributed by fedora. + + -- Peter S Galbraith Sat, 19 Dec 2009 09:22:00 -0500 + +emacs-goodies-el (31.2-1) unstable; urgency=low + + * debian-el: + - apt-sources.el: Create syntax table and add comments. + Thanks to Trent W. Buck for the report (Closes: #469971). + * emacs-goodies-el: + - emacs-goodies-el.texi: specify @documentencoding ISO-8859-1 + - cua.el: don't install for emacs22, emacs23 and emacs-snapshot + - matlab.el caused Objective-C files to be visited in matlab-mode, + thanks to Yavor Doganov for the report (Closes: #557932). Created + `matlab-auto-mode' customization variable. + + -- Peter S Galbraith Wed, 02 Dec 2009 22:47:21 -0500 + +emacs-goodies-el (31.1-1) unstable; urgency=low + + * dpkg-dev-el: + - debian-bts-control.el: + - Bug fix: "Symbol's function definition is void: conact", + thanks to Sven Joachim (Closes: #557408). + - Bug fix: "CC's debian-bts-emailaddress, literally", + thanks to Sven Joachim (Closes: #557412). + + -- Peter S Galbraith Sun, 22 Nov 2009 10:54:31 -0500 + +emacs-goodies-el (31.0-1) unstable; urgency=low + + * vm-bonus-el + - package re-activated. + - vm-bogofilter.el: New file. Thanks to Patrice Karatchentzeff + (Closes: #353827). + * dpkg-dev-el: + - debian-changelog-mode.el: Updated URL for "Best practices". + + -- Peter S Galbraith Sat, 14 Nov 2009 17:18:49 -0500 + +emacs-goodies-el (30.11-1) unstable; urgency=low + + * Added debian/README.source + * Fixed rules file to use binary-indep target. + * Various lintian fixes. + * Added COPYING-GPL-v2 COPYING-GPL-v3 to tar ball as requested by + Fedora, who now distribute emacs-goodies-el. + * debian-el: + - debian-bug.el: Add `emacs-bug-web-bug', `emacs-bug-get-bug-as-email': + new commands to interface with Emacs BTS + * dpkg-dev-el: + - debian-bts-control.el: Add command `emacs-bts-control': new command to + interface with Emacs BTS. + + -- Peter S Galbraith Thu, 12 Nov 2009 16:27:41 -0500 + +emacs-goodies-el (30.10-1) unstable; urgency=low + + * debian-el: + - deb-view.el: "deb-view.el fails on own debian-el_30.9-1_all.deb", + thanks to Kevin Ryde (Closes: #554039). + * vm-bonus-el + Add a copyright file. + + -- Peter S Galbraith Tue, 03 Nov 2009 17:00:50 -0500 + +emacs-goodies-el (30.9-1) unstable; urgency=low + + * emacs-goodies-el: + - Bug fix: "'M-x customize-group markdown' doesn't load + markdown-mode.el", thanks to Kevin Ryde (Closes: #551014). Edited + emacs-goodies-custom.el as suggested by Kevin. + * dpkg-dev-el: + - debian-changelog-mode.el: debian-changelog-close-bug does not work + properly under XEmacs 21.4.21 because the arguments passed to + replace-in-string in the inline function debian-chagelog--rris are in + the wrong order (Closes: #476271). (I apologise for losing track of + this bug for so long). + * debian-el: + - deb-view.el: Added support for data.tar.bz2 deb files (Closes: #457094). + - Changed dependency on binutils for bzip2, file and gzip. + + -- Peter S Galbraith Sun, 25 Oct 2009 12:11:31 -0400 + +emacs-goodies-el (30.8-1) unstable; urgency=low + + * debian-el + - Bug fix: "never cleaned up 50debian-el.el", thanks to + jidanni@jidanni.org; (Closes: #487175). Created debian-el.postinst to + delete the old file if found. + - Bug fix: "Outputs wrongly utf-8 chars if the buffer is called + control", thanks to Marco Túlio Gontijo e Silva (Closes: #526374). + Edited deb-view-control-coding to (1) return 'undecided instead or nil + when there's no match, and (2) call deb-view-control-coding only on + exact match of "control" filename. + * Added "${misc:Depends}" Depends as per policy to all binary packages. + * Added "dpkg (>= 1.15.4) | install-info" Depends as per policy to + emacs-goodies-el and debian-el as they install info file. + + -- Peter S Galbraith Sun, 11 Oct 2009 16:17:40 -0400 + +emacs-goodies-el (30.7-2) unstable; urgency=low + + * emacs-goodies-el: + - Bug fix: "dpkg install error on 30.7-1", thanks to Kevin Ryde + (Closes: #550421). New emacs-goodies-loaddefs.el scheme failed with + emacs21 because it doesn't except an empty file. + + -- Peter S Galbraith Sat, 10 Oct 2009 13:03:47 -0400 + +emacs-goodies-el (30.7-1) unstable; urgency=low + + * emacs-goodies-el: + - Bug fix: "dpkg: error processing emacs-goodies-el (--configure):", + thanks to John A Martin (Closes: #550225). The autoloads file + emacs-goodies-loaddefs.el used to be pre-generated using the latest + Emacs flavour, and XEmacs found code that it didn't understand. My + fix is to build it at install time for each installed Emacs flavour. + + -- Peter S Galbraith Thu, 08 Oct 2009 17:35:30 -0400 + +emacs-goodies-el (30.6-1) unstable; urgency=low + + * emacs-goodies-el: + - dirvars.el: Updated to 1.3 (by Benjamin Rutt) + - folding.el: Updated to 2009.0220.1404 + - highlight-completion.el: Updated to 0.08 + - ibuffer.el: Updated to 2.6.1 + - maplev.el : Updated to 2.155 + - matlab.el: Updated to 3.3.0 + - nuke-trailing-whitespace.el: Updated to CVS 1.11 + - rfc-view.el: Updated to 0.12 + - shell-command.el: Updated to CVS 1.38 + - show-wspace.el: Updated to 282 + - silly-mail.el updated. + - wdired.el: Updated to1.9.2pre3 + - home-end.el updated. + - markdown-mode.el: Updated to 1.7, thanks to Jason Blevins + (Closes: #549208). + - Fix typos in control file, thanks to Reuben Thomas + (Closes: #549917, #549918). + - Improved summary of session.el for package description, thanks to + Reuben Thomas (Closes: #549924). + - Move nuke-trailing-whitespace to superseded category, thanks to + Reuben Thomas (Closes: #549923) + + -- Peter S Galbraith Wed, 07 Oct 2009 17:17:59 -0400 + +emacs-goodies-el (30.5-1) unstable; urgency=low + + * emacs-goodies-el: + - perldoc.el: Updated to 1.7 + - htmlize.el: Updated to lastest upstream version. Bug fix: + "htmlize-region complains about Invalid face", thanks to Eric + Warmenhoven (Closes: #544593). + - align-string.el: Updated to lastest upstream version. + - apache-mode.el: Updated to lastest upstream version. + - ascii.el: Updated to 2.2.1 + - boxquote.el: Updated to 1.23 + - browse-kill-ring.el: Updated to (unofficial?) 1.3a, which includes + 50_browse-kill-ring_bug225082.dpatch, now removed. + However 50_browse-kill-ring_bug224751.dpatch was not applied upstream, + so is still included in Debian. + + -- Peter S Galbraith Thu, 03 Sep 2009 10:39:10 -0400 + +emacs-goodies-el (30.4-1) unstable; urgency=low + + * debian-el: + - deb-view.el: Bug fix: "undo limit vs. .deb", thanks to Dan Jacobson + for reporting and to Sven Joachim for the patch. Apologies for + forgetting about it for so long (Closes: #388637). + - debian.el: Bug fix: "deb-view-control-coding assumes buffer-file-name + is non-nil", thanks to Sven Joachim for the report and the patch. + Again, apologies ! (Closes: #523469). + * emacs-goodies-el: + - perldoc.el: Fixed "allow uniquely-named buffers" and "add completion + for modules", thanks to new "upstream" intrigeri@boum.org; + (Closes: #504186, #504230). + * debian/control: Bug fix: "Incorrect Vcs-Browser URL", thanks to + jamessan@debian.org; (Closes: #528295). + Bug fix: "gnus-bonus-el needs to allow emacs23 in dependency", thanks + to Russ Allbery (Closes: #541361). + + -- Peter S Galbraith Wed, 02 Sep 2009 17:05:19 -0400 + +emacs-goodies-el (30.3-1) unstable; urgency=low + + [ Daniel Moerner ] + * Change references in all *-loaddefs.make files to call emacs rather + than emacs21 as emacs21 is scheduled for removal from unstable. + + [ Peter S Galbraith ] + * Update for emacs23 + - Bug fix: "emacs-goodies-el's ido takes precedence over emacs23's", + thanks to Trent W. Buck (Closes: #539853). + - Bug fix: "please update for emacs23", thanks to Sven Joachim + (Closes: #539768). + + -- Peter S Galbraith Tue, 04 Aug 2009 10:15:33 -0400 + +emacs-goodies-el (30.2-1) unstable; urgency=low + + * emacs-goodies-el: + - quack.el: Bug fix: "quack overrides emacs defaults, should probably + be optional (aggressive)", thanks to Sami Liedes (Closes: #536154). + + -- Peter S Galbraith Fri, 17 Jul 2009 17:02:14 -0400 + +emacs-goodies-el (30.1-1) unstable; urgency=low + + [ Daniel Moerner ] + * emacs-goodies-el: + - quack.el: updated to version 0.37, autoload patch + refreshed. (Closes: #530703) + * Bug fix: Remove useless co from Vcs-Cvs field. (Closes: #530702) + + [ Peter S Galbraith ] + * emacs-goodies-el: + - "please add info-dir-section to your info files", thanks to + Norbert Preining (Closes: #528868). + - muttrc-mode.el: Files updated by Kumar Appaiah (Closes: #451477). + + -- Peter S Galbraith Thu, 09 Jul 2009 15:30:33 -0400 + +emacs-goodies-el (30.0-1) unstable; urgency=low + + * emacs-goodies-el: + - pod-mode.el: updated to V0.502, thanks to Kevin Ryde + (Closes: #499473). + - emacs-goodies-loaddefs.el: rebuilt to remove cwebm.el autoloads + (Bug #541348 fixed here but existed since 28.0-1). + New file: + - quack.el: Added file (version 0.34), integration contributed by + Daniel Moerner , (Closes: #509486) + * debian-el: + - debian-bug.el: "List of pseudo-packages not up to date". + Thanks to Tommi Vainikainen (Closes: #526496). + - debian-bug.el: "[PATCH] using the "maintainer mbox" instead of "mbox + folder". Thanks to Evgeny M. Zubok (Closes: #521571). + - debian-bug.el: "incomplete Bugs menu again", thanks to A Mennucc + (Closes: #524043). + + -- Peter S Galbraith Thu, 14 May 2009 21:36:06 -0400 + +emacs-goodies-el (29.5-1) unstable; urgency=low + + * debian-el: + - debian-bug.el: + Bug fix: Adapted patch from Håkon Stordahl to quote bug descriptions + when building the bug menu. (Closes: #489786). + Bug fix: Applied patch from Håkon Stordahl + for garbled Help buffer (Closes: #502426). + - apt-utils.el: + Fix help text error, thanks to Jens Thiele (Closes: #459958) + - debian-el.el: + Add code from Kevin Ryde to set deb-view control file coding system + (Closes: #484027) + * dpkg-dev-el: + - dpkg-dev-el.el: + Moved some stuff in from 50dpkg-dev-el.el. + Added README.Source to auto-mode-alist, thanks to Noah Slater + (Closes: #490292). + - debian-control-mode.el + Applied patch from Morten Kjeldgaard changing Dm-Upload-Allowed to + DM-Upload-Allowed (Closes: #508748). + - debian-bts-control.el + Applied patch from Luca Capello adding + `debian-bts-control-cc-or-bcc' (Closes: #392494) + - debian-changelog-mode.el + Added patch from Jari Aalto to finalize date in UTC (User + configurable) (Closes: #503700) + * vm-bonus-el + - This is now a dummy package since u-vm-color.el is now bundled and + maintained with VM. Thanks to Sven Joachim (Closes: #510945). + + -- Peter S Galbraith Mon, 23 Feb 2009 20:11:51 +0000 + +emacs-goodies-el (29.4-1) unstable; urgency=high + + * debian-el: + - debian-bug.el: + Bug fix: "Bug submenus have vanished", thanks to Bill Wohler for the + report and to Camm Maguire for an initial patch (Closes: #463053). + This _should_ go in lenny; I have only changed code that was currently + broken under the new Debian bug web page format. + * emacs-goodies-el: + - markdown-mode.el: Thanks to Jason Blevins for the new upstream version + 1.6. It fixes "blockquote-region only works if the region was selected + with the mouse" submitted by Daniel Burrows (Closes: #456592). + + -- Peter S Galbraith Tue, 09 Sep 2008 21:28:31 -0400 + +emacs-goodies-el (29.3-2) unstable; urgency=low + + * devscripts-el: + - Bug fix: "devscripts-el: missing dependency on apel (mcharset.el)". + Thanks to Luca Capello (Closes: #483244). + + -- Peter S Galbraith Wed, 28 May 2008 19:46:13 -0400 + +emacs-goodies-el (29.3-1) unstable; urgency=low + + * devscripts-el: + - Bug fix: "devscripts-el: Downgrade elserv dependency to Recommends". + Thanks to Tim Retout (Closes: #475791). + + -- Peter S Galbraith Mon, 26 May 2008 20:17:18 -0400 + +emacs-goodies-el (29.2-1) unstable; urgency=low + + * emacs-goodies-el: + - Updated to lastest version compatible with GPL V3: + box-quote.el + mutt-alias.el + obfusurl.el + protocols.el + services.el + thinks.el + tld.el + - rfcview.el: Updated from maintained version at + http://www.loveshack.ukfsn.org/emacs/rfcview.el + Should fix fontification bug reported by jidanni@jidanni.org + but no longer works with XEmacs (it requires view.el). + (Closes: #464940). + - Fix S-Lang spelling in package description. + Thanks to Rafael Laboissiere (Closes: #460445). + * debian-el: + - Enable apt-sources-mode for files in /etc/apt/sources.list.d/". + Thanks to Géraud Meyer for the report and patch (Closes: #475701). + * dpkg-dev-el: + - Generalise automatic invocation to files named debian/package.changelog + Thanks to Trent W. Buck for the report and patch. (Closes: #457047) + + -- Peter S Galbraith Sat, 12 Apr 2008 09:49:26 -0400 + +emacs-goodies-el (29.1-1) unstable; urgency=low + + [ Sven Joachim ] + * vm-bonus-el: + - Don't include vm-rfaddons.el and depend on vm versions + that ship that file (Closes: #469652, #469625). + + [ Cyril Brulebois ] + * dpkg-dev-el: + - debian-control-mode.el: Added `Dm-Upload-Allowed' to the list of + valid fields for the source packages. + + [ Peter S Galbraith ] + * Bug fix: "emacs-goodies-el: FTBFS if built twice in a row", thanks to + Sven Joachim (Closes: #469751). + + -- Peter S Galbraith Wed, 26 Mar 2008 20:26:56 -0400 + +emacs-goodies-el (29.0-1) unstable; urgency=low + + [ Cyril Brulebois ] + * debian/changelog: + - Converted to UTF-8. Thanks to Bas Zoetekouw. + (Closes: #453964, #453973, #453974, #453978, #454008, #454034). + - Deleted local variables at the end, Emacs shouldn't need this any + longer. + - Nuked trailing spaces at the same time. + * emacs-goodies-el: + - pod-mode.el: Added file (version 0.4), as suggested by + Emmanuel Bouthenot (Closes: #452857). + * debian/control: + - Added Vcs-Cvs and Vcs-Browser fields. + + [ Peter S Galbraith ] + * emacs-goodies-el: + - minibuffer-complete-cycle.el: Updated to V1.14 with patch from + Sebastian P. Luque. + + -- Peter S Galbraith Tue, 04 Dec 2007 19:41:04 -0500 + +emacs-goodies-el (28.3-1) unstable; urgency=low + + [ Peter S Galbraith ] + * emacs-goodies-el: + - htmlize.el: Updated file to V1.34 (Thanks to S.P. Tseng). + - todoo.el: Symbol's function definition is void: + outline-font-lock-level", I had forgotten an instance of that old + function. Thanks to Jens Thiele and Sven Joachim (Closes: #447760). + * debian-el: + - apt-utils.el: "suggest apt-utils-show-package defer package name + completions", thanks to Kevin Ryde and Matt Hodges (Closes: #442425). + + [ Cyril Brulebois ] + * emacs-goodies-el: + - markdown-mode.el: Updated file to V1.5. + * dpkg-dev-el: + - debian-control-mode.el: Renamed `XS-Vcs-*' into `Vcs-*' since these + fields are now recognized by dpkg (since 1.14.7). + + -- Peter S Galbraith Tue, 23 Oct 2007 20:31:24 -0400 + +emacs-goodies-el (28.2-1) unstable; urgency=low + + [ Cyril Brulebois ] + * emacs-goodies-el: + Updated file: + - show-wspace.el: upstream has added a `show-ws-' prefix to improve + semantics and avoid namespace clash. + * dpkg-dev-el: + Updated file: + - debian-control-mode.el: added `Homepage' to the list of the valid fields + for the source packages. + - debian-control-mode.el: added `XS-Vcs-Browser' and `XS-Vcs-*' to the + list of the valid fields for the source packages. The list of valid * + has been taken from: + http://svn.debian.org/wsvn/qa/trunk/pts/www/bin/common.py?op=file + Patch contributed by Rafael Laboissiere (Closes: #422491). + + -- Peter S Galbraith Wed, 03 Oct 2007 19:36:13 -0400 + +emacs-goodies-el (28.1-1) unstable; urgency=low + + * emacs-goodies-el: + - xrdm-mode.el: Added pointer to `xrdb-mode-setup-auto-mode-alist' + customization to enable this feature in both Info file and + README.Debian. . Thanks to Reuben Thomas (Closes: #411434). + + -- Peter S Galbraith Mon, 24 Sep 2007 20:54:42 -0400 + +emacs-goodies-el (28.0-1) unstable; urgency=low + + [ Cyril Brulebois ] + * debian/control: + - Removed Roland Mas from the Uploaders upon his request. + * emacs-goodies-el: + New file: + - show-wspace.el: highlights whitespaces of various kinds. + Thanks to Lennart Poettering for the suggestion (Closes: #422876). + + [ Peter S Galbraith ] + * debian-el: + - gnus.BTS.el: Implement "reading bugs as mail instead of in browser". + Thanks to Johannes Rohr for the report and to intrigeri for the patch + (Closes: #218286). + - debian-bug.el: Add `debian-bug-get-bug-as-email-hook' and relative + `run-hooks' patch from Luca Capello (Closes: #392475) + * emacs-goodies-el: + - cwebm.el: Blank out the contents of cwebm.el, whose license is not + compatible with Emacs. + - rfcview.el: Add hyperlinks for rfcview.el patch from Dave Love + (Closes: #377678). + + -- Peter S Galbraith Mon, 24 Sep 2007 20:36:30 -0400 + +emacs-goodies-el (27.7-1) unstable; urgency=low + + * debian-el: + - gnus-BTS.el: fails when clicking a bug. Thanks to Jhair Tocancipa + Triana and Manoj Srivastava for reports, and to Elias Oltmanns for + testing my fix. (Closes: #363161, #442438). + * gnus-bonus-el: + - gnus-pers.el: gives newsgroup setting priority over interactive + choice". Thanks to Bruce Stephens and to Elias Oltmanns + (Closes: #263371). + + -- Peter S Galbraith Tue, 18 Sep 2007 21:38:17 -0400 + +emacs-goodies-el (27.6-1) unstable; urgency=low + + * gnus-bonus-el: + - gnus-pers.el: "Cc-fix feature in gnus-pers is horribly broken". + Thanks to Elias Oltmanns for the report and the patches, and I + apologise for the delay in applying them! (Closes: #384209). + + -- Peter S Galbraith Mon, 17 Sep 2007 22:15:29 -0400 + +emacs-goodies-el (27.5-1) unstable; urgency=low + + * debian-el: debian-bug.el (and debian-changelog-mode.el) + - Implement pacakge lookup on http://packages.debian.org/ + See http://bugs.debian.org/87725 + * dpkg-dev-el: + - Patch from Luca Capello to add keys to generate the + open bug alist (Closes: #430517). + + -- Peter S Galbraith Sun, 02 Sep 2007 21:39:14 -0400 + +emacs-goodies-el (27.4-1) unstable; urgency=low + + * dpkg-dev-el: + - debian-bts-control.el: Added `fixed' `notfixed' `block' `unblock' + `archive' `unarchive' `found' `notfound'. Thanks to intrigeri + (Closes: #391647). + + -- Peter S Galbraith Thu, 30 Aug 2007 09:27:43 -0400 + +emacs-goodies-el (27.3-1) unstable; urgency=low + + * dpkg-dev-el: + - debian-bts-control.el: debian-bts-control suffers of bug #336466 and + doesn't skip over mml directives. + Thanks to Luca Capello (Closes: #392132). + + -- Peter S Galbraith Thu, 30 Aug 2007 08:25:26 -0400 + +emacs-goodies-el (27.2-1) unstable; urgency=low + + * debian-el: + - debian-bug.el: "Bugs menu gone due to missing + debian-changelog-close-bug-statement", thanks to Bill Wohler + (Closes: #440002). + * emacs-goodies-el: + - Bug fix: Lists packages available in emacs22 separately. + Thanks to Trent W. Buck (Closes: #438498). + - Bug fix: "Description field typo, s/: / - /." + Thanks to Trent W. Buck (Closes: #438497). + - cfengine.el: Updated to better version of cfengine.el. + Thanks to its author, Dave Love (Closes: #377675). + - todoo-mode.el: Symbol function definition is void: + outline-font-lock-level in todoo-indent-line". + Thanks to Kumar Appaiah (Closes: #438964). + + -- Peter S Galbraith Wed, 29 Aug 2007 22:01:32 -0400 + +emacs-goodies-el (27.1-1) unstable; urgency=low + + * emacs-goodies-el: postinst failed with emacs22 because silly-mail + required sendmail.el and failed to byte-compile if /usr/bin/mail + didn't exist. Thanks to Josh Triplett (Closes: #434104). + + -- Peter S Galbraith Wed, 08 Aug 2007 19:42:02 -0400 + +emacs-goodies-el (27.0-1) unstable; urgency=low + + [ Cyril Brulebois ] + * emacs-goodies-el: + New file: + - markdown-mode.el: major mode for editing Markdown files + (Closes: #435485). + + [ Peter S Galbraith ] + * debian/compat thanks to Michael Olson. + * debian-el: + - /etc/emacs/site-start.d/51debian-el.el: Typo: debian-el-el, + thanks to Josh Triplett (Closes: #427770). + * dpkg-dev-el: + - debian-bts-control.el: Use `C-c C-b' instead of `C-c c' (Closes: #435247). + - debian-changelog-model.el: + auto-mode-alist for "/debian/*NEWS" files, thanks to Per Olofsson + (Closes: #424779). + * emacs-goodies-el: + - tabbar.el updated to version 2.0 and Info updated as well. + Thanks to Michal Sojka (Closes: #435335). + + -- Peter S Galbraith Wed, 08 Aug 2007 18:47:33 -0400 + +emacs-goodies-el (26.13-1) unstable; urgency=low + + * Bug fix: "gnus-bonus-el does not know about emacs22", thanks to + Mikhail Gusarov (Closes: #434491). + * Bug fix: "emacs-goodies-el: Please prefer emacs22 as first + alternative", thanks to Sven Joachim (Closes: #432100). + * Bug fix: "[debian-bug.el, debian-changelog-mode.el] please be + consistent for the close statement", thanks to Luca Capello (Closes: + #431091). + * Bug fix: "cyclebuffer.el too old global-set-key example", thanks to + Dan Jacobson (Closes: #371861). + * Bug fix: "emacs-goodies-el: df-mode break minor-mode-alist and + function using it". Added 50_df_minor_mode_alist.dpatch thanks to + Remi Vanicat (Closes: #430788). + + -- Peter S Galbraith Wed, 25 Jul 2007 21:53:16 -0400 + +emacs-goodies-el (26.12-1) unstable; urgency=low + + [ Michael Olson ] + * debian/emacs-goodies-el.emacsen-install.in: + - (EXCLUDED_emacs22): Exclude programs that are part of Emacs 22. + * debian/compat: + - Set to 4 to silence lintian warning. + * debian/control: + - (Standards-Version): Set to 3.7.2 + - (Build-Depends): Move debhelper and dpatch here. + * debian/rules: + - Don't set DH_COMPAT. + [ Junichi Uekawa ] + * devscripts-el: + - unset read-only state in debuild. + * pbuilder-mode.el: + - unset read-only state. + [ Peter Galbraith ] + * gnus-bonus-el.emacsen-install.in, debian-el.emacsen-install.in: Setup + emacs22 with similar exceptions as emacs-snapshot. + + -- Peter S Galbraith Fri, 20 Jul 2007 10:14:25 -0400 + +emacs-goodies-el (26.11-1) unstable; urgency=low + + * dpkg-dev-el: + - debian-changelog-mode.el: Use "date -R" instead of deprecated + "822-date". Thanks to Matej Vela. (Closes: #423142, #423155, #423828) + * emacs-goodies-el: + - todoo.el: Comment out clobbering of outline-mode-menu-bar-map key + entries. This is far too aggressive. A much better fix would be to + undefine the keys for todoo-mode-map. Thanks to Simon Pepping + (Closes: #414781). + - filladapt.el: Make turn-on-filladapt-mode interactive. + Thanks to Kevin Ryde (Closes: #420845). + + -- Peter S Galbraith Mon, 14 May 2007 19:26:43 -0400 + +emacs-goodies-el (26.10-1) unstable; urgency=low + + [ Junichi Uekawa ] + * dpkg-dev-el: + - debian-changelog-mode.el: support co-maintainers. If previous + maintainer editing the entry is different from the current, an + entry of the form '[ NAME ]' is created. + Thanks to Luca Capello (Closes: #352957). + * debian-el: + - fix debian-bug.el (debian-bug-build-bug-menu) to work with new + BTS output format. + [ Peter S Galbraith ] + * gnus-bonus-el: + - gnus-pers.el: gnus-functionp is absent in Oort Gnus, thanks + to Dmitry Astapov (Closes: #416360). + * emacs-goodies-el: + - emacs-goodies-el.el: xrdb-mode clobbers bindings in emacs-snapshot, + thanks to R.Ramkumar (Closes: #402580). + - emacs-goodies-el.el: Too many files put into cfengine-mode, + thanks to Sven Joachim (Closes: #408285). + - emacs-goodies-el.el: "add apache2.conf to auto-mode-alist", + thanks to Shannon Eric Peevey (Closes: #392719). + * dpkg-dev-el: + - 50dpkg-dev-el.el: "Fixed native package changelog coding system for + emacs 22", thanks to Kevin Ryde (Closes: #416218). + - debian-bts-control.el: typo in debian-bts-control-modes-to-reuse, + thanks to Luca Capello (Closes: #392274). + * debian-el: + - debian-bug.el: Updated list of pseudo packages, + thanks to Sven Joachim (Closes: #417882). + + -- Peter S Galbraith Mon, 14 May 2007 19:24:37 -0400 + +emacs-goodies-el (26.9-1) unstable; urgency=low + + * debian-el: + - debian-bug.el: Added "Owner:" to ITP bugs. Thanks to Romain + Francoise for bringing this to my attention (Closes: #388747). + * dpkg-dev-el: + - debian-bts-control.el: Some tags are missing in the list". I also + updated debian-bug.el. Thanks to Thomas Weber (Closes: #373283). + + -- Peter S Galbraith Fri, 22 Sep 2006 15:29:06 -0400 + +emacs-goodies-el (26.8-1) unstable; urgency=low + + * dpkg-dev-el: + - debian-changelog-mode.el: Allow tilde (~) in version numbers", thanks + to Rafael Laboissiere for the report and to Peter Samuelson for the + patch (Closes: #382514). + * emacs-goodies-el: + - folding.el: Updated to latest CVS version. + + -- Peter S Galbraith Mon, 11 Sep 2006 12:02:32 -0400 + +emacs-goodies-el (26.7-1) unstable; urgency=low + + By Jaakko Kangasharju : + * gnus-bonus-el: + - Verify gnus-newsgroup-name is set before using it (Thanks to Elias + Oltmanns) (Closes: #384402) + By Junichi Uekawa : + * debian-el: + - debian-changelog-mode.el: Does not support bugs with only e-mail + address and no full name. (Closes: #380217). + By Peter S Galbraith : + * debian-el: + - apt-utils.el: New upstream release 2.8.0: + - debian-bug.el: Bug fix: "debian-el: debian-bug-prompt-bug-number + missing word-at-point", thanks to Kevin Ryde (Closes: #384542). + * emacs-goodies-el: + - Bug fix: minor info manual error", thanks to Sebastian Luque + (Closes: #385234). + + -- Peter S Galbraith Tue, 5 Sep 2006 20:53:27 -0400 + +emacs-goodies-el (26.6-1) unstable; urgency=low + + * dpkg-dev-el: + - readme-debian.el: (Changed by Junichi Uekawa ) + set locale to C for obtaining rfc822-style date, follow-up for + fix for 351010. (closes: #364770) + - remove duplicate add-to-list for auto-load-alist. + (Changed by Junichi Uekawa ) + - readme-debian.el: Better regexp to activate on *.Debian$ files". + Thanks to Jari Aalto for the bug and the patch (Closes: #354970). + - "utf-8 for debian/control file", thanks to Kevin Ryde (Closes: #365796). + * emacs-goodies-el: + - Bug fix: "Modify emacs-goodies-el's dependency on bash to allow + bash-static instead", thanks to maru dubshinki (Closes: #364852). + * gnus-bonus-el: + - Bug fix: "not fully installed message in e,acs-snapshot", thanks to + Dan Jacobson (Closes: #369618). + * debian-el: + - debian-bug.el: "Change the face of Tags: for experimental", thanks to + Luca Capello for the bug and patch (Closes: #357265). + + -- Peter S Galbraith Tue, 30 May 2006 19:43:18 -0400 + +emacs-goodies-el (26.5-2) unstable; urgency=low + + * Bug fix: "dpkg-dev-el: Error message during configuration of + emacs-snapshot", thanks to Sven Joachim for reporting this. + It Turns out that the /etc/emacs/site-start.d/ startup files were + trying to load byte-compiled files in + /usr/share/emacsFLAVOR/site-lisp/PACKAGE directories that don't exist + because the package hasn't been fully installed yet. I now check for + this condition. (Closes: #341829). + + -- Peter S Galbraith Tue, 21 Feb 2006 21:24:10 -0500 + +emacs-goodies-el (26.5-1) unstable; urgency=low + + * dpkg-dev-el: + - readme-debian.el: Update date not in RFC822 format. + Thanks to Luca Capello for the bug report and patch (Closes: #351010). + * debian-el: + - deb-view.wl: Bug fix: Fails if coding system utf-8 is preferred. + Thanks to Sven Joachim for the report and the patch (Closes: #344260). + * emacs-goodies-el: + - emacs-goodies-el: Bug fix: home-end-enable defcustom clobbers bindings. + Thanks to Matt Hodges for the bug report (Closes: #340694). + - edit-env.el: Symbol's function definition is void: copy-list. + Thanks to Sven Joachim for the bug report (Closes: #340735). + + -- Peter S Galbraith Thu, 2 Feb 2006 22:13:10 -0500 + +emacs-goodies-el (26.4-1) unstable; urgency=low + + * debian-el: + - debian-bug.el: Swap "^CC:" for X-Debbugs-CC: in mail header. + Thanks to Luca Capello (Really closes: #208570). + * dpkg-dev-el: + - debian-control-mode.el: Make # the comment character. + Thanks to Romain Francoise for the suggestion (Closes: #339868). + + -- Peter S Galbraith Tue, 22 Nov 2005 20:59:11 -0500 + +emacs-goodies-el (26.3-1) unstable; urgency=low + + * emacs-goodies-el: + - Info manual concerning under.el: s/underline-region/underhat-region/ + in info page", thanks to Luca Capello (Closes: #336938). + - Leaves temporary file behind if already configured", thanks to + Romain Francoise for the report and the patch (Closes: #336830). + * debian-el: + - debian-bug.el: Use bug number under point as prompt default whenever + possible. Thanks to Luca Capello (Closes: #337233). + - debian-bug.el: Swap CC: for X-Debbugs-CC: in mail header. + Thanks to Francesco Potorti` (Closes: #208570). + - debian-bug.el: debian-bug-wnpp must skip over mml directives in + new mail drafts. Thanks to Luca Capello for reporting (Closes: #337659) + - gnus-BTS.el: Invalid function macro trying to view an article. I + wasn't skipping byte-compilation for gnus-BTS.el, I was skipping + installation! I added a new method to install yet skip + byte-compilation. Thanks to Luca Capello (Closes: #336935). + - apt-utils.el: New upstream release: + Files in apt-utils-search-file-names are now hyperlinks; + New command, apt-utils-view-version, to report the installed version + of a package. + + -- Peter S Galbraith Sat, 5 Nov 2005 13:12:35 -0500 + +emacs-goodies-el (26.2-1) unstable; urgency=low + + * emacs-goodies-el: + - slang-mode.el: Bad default for slang-default-application. Thanks to + Sven Joachim (Closes: #336352). + - htmlize.el: New upstream version 1.27. + Thanks to Hrvoje Niksic (Closes: #336356). + * debian-el: + - debian-bug.el: debian-bug-package must skip over mml directives in + new mail drafts. Thanks to Luca Capello for reporting (Closes: #336466) + + -- Peter S Galbraith Sun, 30 Oct 2005 20:49:34 -0500 + +emacs-goodies-el (26.1-1) unstable; urgency=low + + * New package vm-bonus-el: Miscellaneous add-ons for VM. + - vm-rfaddons.el: a collections of various useful VM helper functions. + - u-vm-color.el: font-lock support for VM. + Thanks to Patrice Karatchentzeff for the suggestion. (Closes: #244444) + * Removed transitional packages: + emacs-goodies-extra-el, debbugs-el and debview + * debian-el: + - deb-view.el V1.12: Bug fixes suggested by Dan Jacobson. + + Output an error message if the package file is corrupted + (e.g. partial download) (Closes: #235673). + + deb-view-dired-view: Check if file in dired is a .deb before opening + (Closes: #273902). + + deb-view-tar-view: If the file to be opened is from the INFO buffer, + then open in the other (larger) window (Closes: #321869). + New files: + - pressed.el: a major mode for editing debian-installer preseed files. + Thanks to W. Borgert for suggesing and providing it. + (Closes: #279061) + * dpkg-dev-el: + - 50dpkg-dev-el.el: Only apply utf-8 coding-system if it exists. + * emacs-goodies-el: + - matlab.el: New upstream version, updated to 3.0.1 + - boxquote.el: New upstream version, updated to 1.18, + Thanks to Simon Taylor (Closes: #335070). + - bar-cursor.el bug fix: In my previous fix, I forgot to undo skipping + installation for emacs-snapshot (Closes: #331430). + New files: + - maple.el: major mode for editing Maple files. Thanks to Anders + Lennartsson for suggesting it (Closes: #334425). + - color-theme.el: changes the colors used within Emacs (Closes: #144420). + + -- Peter S Galbraith Tue, 25 Oct 2005 22:08:16 -0400 + +emacs-goodies-el (25.1-1) unstable; urgency=low + + * General Bug fix: "compiling *.el files should display errors, not just + log file name", thanks to Jari Aalto (Closes: #309790). I implemented + the suggested grep for byte-compilation warnings and now delete the + temporary log files after their creation ("debian-el: leaves temporary + files in /tmp after installation", thanks to Lars Wirzenius; Closes: + #331114). + * emacs-goodies-el: + - emacs-goodies-el.el: Key binding for wdired didn't get properly + defined in emacs-snapshot, thanks to Sven Joachim for the report and + the patch (Closes: #329883). + - dict.el: `current-word' can return nil", thanks to Jorgen Schaefer + for the report and patch. (Closes: #301293). + - shell-command.el: New upstream version. Also fixed bug "activation + is documented wrongly" from Sven Joachim. The activation has changed + to using the variable `shell-command-completion-mode'. (Closes: #331421) + - bar-cursor.el bug fix: Loading the library changes cursor to hollow + box in emacs-snapshot", Thanks to Sven Joachim for the report and the + patch (Closes: #331430). + New files: + - cfengine.el: major mode for editing cfengine files. + Thanks to Morten Werner Olsen (Closes: #280415). + - csv-mode.el: major mode for editing comma-separated value files + (Closes: #260705) + - cua.el: emulate CUA key bindings (C-z undo, C-x cut, C-c copy, C-v paste) + - cwebm.el: a CWEB/WEB modified mode. + Thanks to Max Vasin (Closes: #326772). + - ido.el: a faster way to switch buffers and get files. + Thanks to Cyril Bouthors (Closes: #293732). + - matlab.el: a major mode for MATLAB dot-m files + tlc.el: a major mode for editing Target Language Compiler scripts + Thanks to Riccardo Vestrini (Closes: #246379). + - minibuf-electric.el: Electric minibuffer behavior from XEmacs. + Thanks to Karl Hegbloom (Closes: #317566). + - slang-mode.el: a major-mode for editing slang scripts. + Thanks to Rafael Laboissiere (Closes: #297828). + - tabbar.el: Display a tab bar in the header line. + Thanks to Josh Triplett for both suggestions and a patch + (Closes: #237341). + * gnus-bonus-el: (Jaakko Kangasharju ) + - gnus-filterhist.el: Move face-changing command inside temporary buffer + manipulation (Closes: #331234) + + -- Peter S Galbraith Sat, 15 Oct 2005 15:31:53 -0400 + +emacs-goodies-el (24.15-2) unstable; urgency=low + + * symlink .el files alongside .elc files such that they are available + for `find-function' et al. (Closes: #329114 again) + + -- Peter S Galbraith Thu, 22 Sep 2005 21:23:58 -0400 + +emacs-goodies-el (24.15-1) unstable; urgency=low + + * gnus-bonus-el: + - no longer add /usr/share/emacs/site-lisp/gnus-bonus-el to load-path + since that shadows emacs-snapshot packages nnnil.el and spam-stat.el + - skip byte-compilation for unsupported emacs20. Thanks to Thomas + Bushnell BSG for reporting it and noticing the Emacs20 involvement. + (Closes: #329430). + * emacs-goodies-el: + - Fix buglet in `wdired-enable' setting. + + -- Peter S Galbraith Wed, 21 Sep 2005 19:32:28 -0400 + +emacs-goodies-el (24.14-1) unstable; urgency=low + + * dpkg-dev-el: + - debian-bts-control.el: Pick bug number at point for debian-bts-control + messages", thanks to Jari Aalto for the idea and patch (Closes: #325095). + * emacs-goodies-el: + - no longer add /usr/share/emacs/site-lisp/emacs-goodies-el to load-path + since that shadows emacs-snapshot packages such as ibuffer and others. + (Closes: #329114) + + -- Peter S Galbraith Tue, 20 Sep 2005 21:44:18 -0400 + +emacs-goodies-el (24.13-1) unstable; urgency=low + + * debian-el: + - debian-bug.el: debian-bug-build-bug-menu was broken from BTS HTML + format changes (Closes: #329034). + - gnus-BTS.el: Minor bug fix preventing byte-compilation on + emacs-snapshot. + * dpkg-dev-el: + - Handle changelog coding system for debian native package, by Kevin + Ryde (Closes: #317597). + - debian-changelog-mode.el: Add outline-regexp and C-cC-n and C-cC-p + movement commands as suggested by Romain Francoise (Closes: #322994) + * emacs-goodies-el: + - tld.el: new upstream version omits FX which does not exist, + thanks to Stephane Bortzmeyer for reporting this (Closes: #273588). + - Skip byte-compilation for wdired.el ibuffer.el table.el newsticker.el + for emacs-snapshot, since it has these files (Same for package + gnus-bonus-el and files nnnil.el and spam-stat.el). Also only define + the "r" key in dired-mode if `emacs-goodies-el-defaults' is set. + (Closes: #329114) + + -- Peter S Galbraith Mon, 19 Sep 2005 19:25:31 -0400 + +emacs-goodies-el (24.12-1) unstable; urgency=low + + * No longer call (setq load-path (substitute "." nil load-path)) in startup + scripts since it's no longer useful and required 'cl to work correctly. + Thanks to Kevin Ryde for finding this and reporting it! (Closes: #328712) + * emacs-goodies-el: + - newsticker.el: new upstream version 1.8 + - ff-paths.el: new upstream version 3.23 + - emacs-goodies-el.el: Double entry in Dired menu on Emacs 22 fixed by + Sven Joachim (Closes: #323754) + - perldoc.el: Apply patch from Kevin Ryde for when perldoc package is + not installed. (Closes: #314869) + * devscripts-el: (Changed by Junichi Uekawa ) + - minor cosmetic fix on output of pbuilder-build command; add a missing + newline + * debian-el: + - gnus-BTS: Emacs namespace is being polluted (incorrect + naming of funcs/vars). Thanks to Jari Aalto for the updated file. + (Closes: #324116) + * gnus-bonus-el: + dependency compatible with emacs-snapshot. + Thanks to Luca Capello. (Closes: #322536) + * dpkg-dev-el: + debian-changelog-mode.el: Apply patch from Rafael Laboissiere adding + debian-changelog-add-version-hook defaulting to + debian-changelog-add-new-upstream-release (Closes: #296725) + + -- Peter S Galbraith Sun, 18 Sep 2005 19:47:11 -0400 + +emacs-goodies-el (24.11-2) unstable; urgency=low + + * emacs-goodies-el: + - perldoc.el: Handle case when perl-doc is not installed", thanks to + Kevin Ryde for the report and a stab at fixing it (Closes: #314869). + + -- Peter S Galbraith Thu, 23 Jun 2005 19:14:00 -0400 + +emacs-goodies-el (24.11-1) unstable; urgency=low + + * debian-el: + - apt-utils.el: "apt-utils-show-package is broken", thanks to Thamer + Mahmoud for reporting it and to Matt Hodges for fixing it in a new + upstream version (Closes: #302888, #312000). + * devscripts-el: (Changed by Junichi Uekawa ) + - autoload 'debi'; fix spelling mistake in pduilder->pbuilder + (closes: #305109) + * dpkg-dev-el: + - debian-changelog-mode.el: "`(fboundp (quote imenu))' called for + effect", thanks to Jari Aalto for the patch (Closes: #309788). + - 50dpkg-dev-el.el: Make debian changelogs default to utf-8, + thanks to Kevin Ryde for the patch (Closes: #315494). + + -- Peter S Galbraith Thu, 23 Jun 2005 13:00:40 -0400 + +emacs-goodies-el (24.10-1) unstable; urgency=low + + * debian-el: + - debian-bug.el: Patch from Kevin Ryde adds gnus + support to debian-bug-get-bug-as-email, bringing the bug + messages up in a gnus group. (Closes: #288469) + * emacs-goodies-el: + - apache-mode.el: Bug fix: "emacs-goodies-el: uncomment-region does + not work with closing tags like ", thanks to Cyril + Bouthors for reporting this (Closes: #283840). The bug is fixed by + switching to a new version now maintained by Karl Chen. + * dpkg-dev-el: + - debian-control-mode.el: Bug fix: "mouse-pasting fails and starts + Mozilla in Debian control mode", thanks to Antti-Juhani Kaijanaho + (Closes: #293629). I changed the binding from mouse-2 to C-mouse-2. + + -- Peter S Galbraith Mon, 7 Feb 2005 21:27:58 -0500 + +emacs-goodies-el (24.9-2) unstable; urgency=low + + * Use debian-emacs-flavor instead of flavor in startup files and replace + occurrences of nil by "." in load-path for the sake of + debian-pkg-add-load-path-item. + + -- Peter S Galbraith Wed, 15 Dec 2004 21:04:21 -0500 + +emacs-goodies-el (24.9-1) unstable; urgency=low + + * emacs-goodies-el: + - todoo.el: outline-regexp improperly made buffer-local, + thanks to Cyril Bouthors for reporting (Closes: #284083). + + -- Peter S Galbraith Fri, 3 Dec 2004 15:30:07 -0500 + +emacs-goodies-el (24.8-1) unstable; urgency=low + + * debian-el: + - apt-utils.el: Updated to latest version from Matt, in which he fixed + dependence on jka-compr (Closes: #278929) and addressed the issue of + memory usage (Closes: #252481). + * emacs-goodies-el: + - todoo.el: changes to outline-regexp should be buffer-local + (Closes: #267637). Thanks to Daniel Skarda <0rfelyus@hobitin.ucw.cz> + for pointing it out. + - folding.el: Updated to latest CVS version to fix bug: "folding.el: + support for BibTeX-mode is b0rken", thanks to Juhapekka Tolvanen + (Closes: #282388). + + -- Peter S Galbraith Thu, 25 Nov 2004 22:06:03 -0500 + +emacs-goodies-el (24.7-1) unstable; urgency=low + + * debian-el: + - apt-utils.el: new upstream version from Matt. + - debian-bug.el: Bug fix: "debbugs-el: M x debian-bug fails due to new + reportbug syntax; Add "--list-cc=none" to call to reportbug". + Thanks to Camm Maguire for the patch (Closes: #280780). + * emacs-goodies-el: + - newsticker.el: New upstream release (1.6). + + -- Peter S Galbraith Fri, 12 Nov 2004 15:41:48 -0500 + +emacs-goodies-el (24.6-2) unstable; urgency=low + + * gnus-bonus-el + - Attempt to fix Bug: "gnus-bonus-el: search-failed "--text follows this + line--". Thanks to Mathieu Roy for reporting, and email back if the + fix doesn't work for you (Closes: #240212). + * Bug fix: "wrong emacsen-install, so logging will fail", + emacsen-install.template used shell-specifix redirection. Thanks to + OHASHI Akira for reporting and providing the fix (Closes: #265478). + + -- Peter S Galbraith Mon, 16 Aug 2004 21:06:11 -0400 + +emacs-goodies-el (24.6-1) unstable; urgency=low + + * gnus-bonus-el + - Bug fix: "Missing file: nnmaildir.el", thanks to Christian Joergensen + for reporting this. The file is actually in the gnus package so I + won't mention it anymore. (Closes: #256260). + * debian-el: + - debian-el.el: Bug fix: "debian-el: Add udeb support to debview", + thanks to Frédéric Botha-my for the suggestion and patch + (Closes: #260273). + - apt-utils.el: new upstream version from Matt, adds "m" key and menu + entry to read man page. Addresses bug report "apt-utils.el: not + friendly" from Dan Jacobson (Closes: #249061). + - debian-bug.el: debian-bug-wnpp now supports RFH tag (Closes: #262985). + * emacs-goodies-el: + - Since todoo.el and ibuffer.el don't work in XEmacs, do autoload + them and document that limitation in the Info docs. Thanks to OHURA + Makoto for reporting (Closes: #244681). + + -- Peter S Galbraith Tue, 3 Aug 2004 20:26:21 -0400 + +emacs-goodies-el (24.5-1) unstable; urgency=low + + * debian/control: Added Jérôme Marant to uploaders. + * debian/changelog: Converted to UTF-8 as per Policy. + * debian/emacsen-install.template: Since dashes are not allowed in + flavour names within shell variables, replace them with underline + characters. (Jérôme Marant). + * dpkg-dev-el: + - debian-changelog-mode.el: "dpkg-dev-el: Warning message for security + uploads should be dismissed". Thanks to Martin Schulze (Closes: #234730) + - debian-changelog-mode.el: "Should mark line beginning with a tab as + invalid". Thanks to Michel Daenzer (Closes: #235310). + + -- Jerome Marant Sun, 16 May 2004 14:00:45 +0200 + +emacs-goodies-el (24.4-1) unstable; urgency=low + + * dpkg-dev-el: + - debian-control-mode.el: Apply patch from Jhair Tocancipa Triana + to fix an after-change-functions race + (Closes: #226770, #236506). + * emacs-goodies-el: + - emacs-goodies-custom.el: Remove duplicate and obsolete entries + for joc-toggle-buffer and joc-toggle-case defcustoms. Thanks to + Kevin Ryde for reporting it (Closes: #234972). + - joc-toggle-buffer.el: Provide joc-toggle-buffer instead of older name + toggle-buffer. Thanks to Kevin Ryde for reporting it (Closes: #234971). + - emacs-goodies-el.texi: Rename node auto-fill-mode-inhibit to + auto-fill-inhibit and pack-window to pack-windows. Thanks to + Kevin Ryde for reporting it (Closes: #234651). + + -- Peter S Galbraith Sat, 27 Mar 2004 19:59:41 -0500 + +emacs-goodies-el (24.3-1) unstable; urgency=low + + * debian-el: + - apt-utils.el: Updated to v1.82 (2004/02/17). Bug fix: "debian-el: + (args-out-of-range 922 922)", thanks to Johannes Rohr for reporting it + (Closes: #232367). Also adds automatic rebuilding of its APT package + list; See `apt-utils-automatic-update'. + * gnus-bonus-el: + - Bug fix: No longer depend on emacs20 since it was removed from + testing, thanks to Martin Michlmayr for reporting it (Closes: #232760). + * dpkg-dev-el: + - debian-changelog-mode.el: Add file NEWS.Debian to auto-mode-alist. + Thanks to Chris Lawrence for suggesting it (Closes: #233310). + + -- Peter S Galbraith Thu, 19 Feb 2004 21:28:32 -0500 + +emacs-goodies-el (24.2-2) unstable; urgency=low + + * gnus-bonus-el: + - gnus-pers.el bug fix: Use functionp instead of relying on + message-functionp being provided by gnus, since recent gnus no longer + has it. Thanks to Brian May for reporting (Closes: #230036). + + -- Peter S Galbraith Wed, 28 Jan 2004 19:53:18 -0500 + +emacs-goodies-el (24.2-1) unstable; urgency=low + + * debian-el: + - apt-utils.el: Updated to v1.78 (2004/01/04). Allow for multiple + buffers in apt-utils-mode that are independent of one another. + Also fix bug: "debian-el: apt-utils-show-package scrolling", thanks to + Kevin Ryde for reporting it (Closes: #225610). + - deb-view.el: Resize top (control) window to fit number of lines since + it doesn't really need to be 1/2 the screen. Thanks to Dan Jacobson + for suggesting this change (Closes: #224950). + * emacs-goodies-el: + - browse-kill-ring.el: cannot setup `*Kill Ring*' buffer with items + propertized read-only", many thanks to INOUE Hiroyuki for reporting it + along with a working fix (Closes: #225082). + - coffee.el: Since `M-x coffee' doesn't work for real, I've removed + its autoload so users can't trip on it accidentally, and I've made it + clear it's a joke package in the Info docs. Thanks to Daniel de + Angelis Cordeiro for reporting (Closes: #225152). + + -- Peter S Galbraith Fri, 16 Jan 2004 15:32:06 -0500 + +emacs-goodies-el (24.1-1) unstable; urgency=low + + * debian-el: + - apt-sources.el: Remove problematic requirement on autoinsert.el + since it's not needed and upstream said he had removed it (but hadn't). + * dpkg-dev-el: + - debian-changelog-mode.el: Bug fix: "error setting distribution + to *-security", thanks to Yann Dirson for reporting (Closes: #224187). + * emacs-goodies-el: + - browse-kill-ring.el bug fix: "can't delete entries with `read-only' + text property (on emacs21.1)", thanks to INOUE Hiroyuki for the report + and the patch (Closes: #224751). + * devscripts-el: (Prepared by Junichi Uekawa) + - debdiff-current: Run debdiff against the previous version found in + the changelog. + * gnus-bonus-el: + - gnus-pers.el bug fix: "Uses message-functionp instead of functionp", + thanks to Brian T. Sniffen (Closes: #223493). + - gnus-pers.el bug fix: "There is no 'replace-in-string' as called by + gnus-pers.el", thanks to Brian T. Sniffen (Closes: #223494). + + -- Peter S Galbraith Mon, 22 Dec 2003 21:00:30 -0500 + +emacs-goodies-el (24.0-1) unstable; urgency=low + + * emacs-goodies-el: + - toggle-buffer.el renamed to joc-toggle-buffer.el + - toggle-case.el renamed to joc-toggle-case.el + New files: + - minibuffer-complete-cycle.el, cycle through possible completions. + Thanks to Hisashi MORITA for suggesting it and to Kevin Rodgers for + accepting my suggestions to the code. Half of #217371. + - lcomp.el, list-completion hacks. Thanks to Hisashi MORITA for + suggesting it (Closes: #217371). + - folding.el, a folding-editor-like minor mode. Thanks to Michael Vogt + (Closes: #161404) and to Jérôme Marant (Closes: #170587) for the + suggestion. + - apache-mode.el, major mode for editing Apache configuration files + Thanks to Jérôme Marant for suggesting it (Closes: #165316). + - ctypes.el, Enhanced Font lock support for custom defined types. + Thanks to Toby Speight (for suggesting it Closes: #212884). + - shell-command.el, enables tab-completion for shell-command. + Thanks to Ole Laursen for suggesting it abd to its author TSUCHIYA + Masatoshi for accepting suggestions for changes (Closes: #219766). + - browse-huge-tar.el, browse tar files without reading them memory. + Thanks to Marcus Crafter for suggesting it (Closes: #161159): + Thanks to John Wiegley for suggesting files below (Closes: #137910): + - edit-env.el, view and edit environment variables. + - dedicated.el, dedicate a window to a single buffer. + - rfcview.el, view IETF RFCs with readability-improved formatting. + (Also thanks to Kevin Ryde for this suggestion; Closes: #222186) + - marker-visit.el, navigate through a buffer's marks in order. + - pack-windows.el, resize all windows to display as much info as possible. + - ascii.el, ASCII code display for character under point. + New upstream versions: + - ff-paths.el: New variables to skip running locate for find very + common file names. Thanks to Stephen Eglen for suggesting it. + (Closes: #220507) + Patches: + - 50_todoo_bug220718: Fix XEmacs keybindings for XEmacs. + Thanks to Gianluca Della Vedova (Closes: #220718). + - 50_joc-toggle-buffer: Add prefix joc- where missing; Fix startup bug. + - 50_joc-toggle-case: Add prefix joc- where missing. + - 50_silly-mail: Add custom support. + Info manual: + - filladapt.el: Document how to use with C, thanks to Kevin Ryde for the + patch (Closes: #221942). + - Document joc-toggle-buffer, joc-toggle-case, silly-mail. + * dpkg-dev-el: + - debian-changelog-mode.el: Make `debian-changelog-add-entry' works + from files in unpacked sources. Thanks to Junichi Uekawa for + suggesting it (Closes: #220641). + Add menu entry for "Archived Bugs for This Package", for + "Developer Page for This Package", "Developer Page for This Maintainer". + - debian-control-mode.el: highlight only known fields (Closes: #213779). + - debian/control: dpkg-dev-el depends on debian-el (>= 24.0-1) for + debian-changelog-mode using debian-bug-web-developer-page. + * debian-el + - apt-utils.el: Updated to v1.72 (2003/11/25). More robust finding of + ChangeLog and README files, and new commands to find NEWS and + copyright files. + - debian-bug: Thanks to Kalle Olavi Niemitalo for both these bug + reports with working patches. :-) + - Contain debian-bug's cursor-in-echo-area to when it's needed so the + list of pseudo-packages can be scrolled. (Closes: #222332) + - debian-bug-package: Let M- and M- scroll the pseudo-package + list window by making _it_ the other window. (Closes: #222333) + - debian-bug.el: Add menu entry for "Archived Bugs for This Package", for + "Developer Page for This Package", "Developer Page for This Maintainer" + (Closes: #222391). + * make-orig.sh bug fix: "cvs .# files in source package", thanks to + Kevin Ryde for reporting it (Closes: #221940). + + -- Peter S Galbraith Sun, 7 Dec 2003 14:38:09 -0500 + +emacs-goodies-el (23.1-1) unstable; urgency=low + + * debian-el: + - deb-view.el: I'm now maintaining this file. New version supports + customization. + - debian-bug.el bug fix: "Should send minor severty bugs to maintonly, + not submit", thanks to Tollef Fog Heen (Closes: #214242). + - debian-bug.el bug fix: "M-x debian-bug prompt doesn't work correctly + in XEmacs21", thanks to Kenshi Muto for reporting (Closes: #219811). + * emacs-goodies-extra-el: + - Re-introduce a harmless 50emacs-goodies-extra-el.el file since old one + not removed in dist-upgrade. + * emacs-goodies-el: + - tc.el: upstream-approved edits. Includes new cite attribution string. + * dpkg-dev-el: + - Edits *all* elisp files in package to add autoload tags. + - Create `dpkg-dev-el.el' and `dpkg-dev-el-loaddefs.el' startup files + and use them in Emacs startup. + + -- Peter S Galbraith Tue, 11 Nov 2003 19:08:37 -0500 + +emacs-goodies-el (23.0-1) unstable; urgency=low + + * gnus-bonus-el: (Prepared by Jérôme Marant) + New files: + - gnus-pers.el, an alternative to gnus-posting-styles. (Closes: #166459) + - gnus-eyecandy.el, enhance the group buffer by adding icons. + - gnus-filterhist.el, add a buffer which display the message filtering + history. + Debian setup: + - Add autoloads for gnus-pers.el, gnus-eyecandy.el and gnus-filterhist.el. + * emacs-goodies-el: + - htmlize.el: new upstream version 1.16 with many enhancements. + Patches: + - 50_newsticker_non-fatal_xml: Don't bail out requiring xml which doesn't + exists on woody XEmacs. Fixes Bug "M-x newsticker-start crashes", + reported by Volker Linke and fixed thanks to advice from Matt Hodges + (Closes: #216233). + - 50_projects: Make projects.el less intrusive by default. Rename + commands to have `project-' prefix. + Info manual: + - documented projects.el and tc.el. + * devscripts-el: (Prepared by Junichi Uekawa) + - implement 'debdiff' + - devscripts-el.README.Debian: update to reflect latest changes. + * debian-el: + - apt-sources.el: new upstream version 0.9.8. + - 50debian-el.el renamed to 51debian-el.el to make sure it runs + _after_ old version of 50debview.el. + - Bug fix: "debbugs-el: gnus-BTS.el causes error on opening article", + thanks to Johannes Rohr for reporting this (Closes: #218227). We no + longer byte-compile gnus-BTS.el since it uses gnus macros and this + breaks if byte-compiled with one version of gnus and used with + another. + * debview: + - Bug fix: Re-introduce an harmless 50debview.el file since old one + not removed in dist-upgrade and autoloaded debview from wrong place. + Thanks to Neil Roeth (Closes: #218094). + + -- Peter S Galbraith Thu, 30 Oct 2003 19:58:16 -0500 + +emacs-goodies-el (22.2-1) unstable; urgency=low + + * devscripts-el: + - Bug fix in packaging: "byte-compilation failures (e20 at least)", + thanks to Aaron M. Ucko for reporting. We'll use full Debian setup of + Emacs packages to byte-compile devscripts-el (Closes: #216037). + * dpkg-dev-el: + - Bug fix: "View upgrading-checklist: fails to decompress", thanks to + Neil Roeth for the thorough report. Fixed by forcing + auto-compression-mode on all flavours of Emacs (Closes: #216040). + * debian/control bug fix: Package descriptions pointed to README.Debian.gz + but the files were not compressed, thanks to Jaume (Closes: #216055). + * debian/*emacsen-install*: Add STAMPFILE and don't byte-compile files + if already done. + + -- Peter S Galbraith Thu, 16 Oct 2003 13:17:13 -0400 + +emacs-goodies-el (22.1-1) unstable; urgency=low + + * emacs-goodies-el: + New upstream versions: + - tc.el: Version 0.13.3. + - table.el: Version 1.5.54. Wow! This is a very cool package! + - tail.el: Benjamin Drieu gave me carte blanche to hack on it, so I + fixed a few bugs, including making it under XEmacs. Thanks to Adam + Sjögren for reporting this bug (Closes: #164372). + - under.el: checkdoc clean; add autoload tag; don't make global + variables; rename underline-region to underhat-region since it + overloaded an existing Emacs21 command. + - htmlize.el: Bug fix "emacs-goodies-el: htmlize-* doesn't appear to + work in TTY", thanks to Gergely Nagy for reporting it (Closes: #127943). + - framepop.el: Don't enable it on non-window Emacs. + Patches: + - nuke-trailing-whitespace.el: Add custom interface support with ability + to install into write-file-hooks. + - protbuf.el: Add custom interface support and make interactive + commands true toggles. + - table.el: Add table-add-to-text-mode-hook defcustom. + - session.el: Remove autoload tag for a defmacro. + - setnu.el: add defface and checkdoc edits. + Info manual: + - documented nuke-trailing-whitespace, protbuf, protocols, services, + setnu, sys-apropos, table, tail, thinks, tld, todoo, toggle-option, + twiddle, under, wdired, xrdb-mode. + * debian-el: + New upstream versions: + - debian-bug.el: decode ISO strings in Debian BTS for properly + formatted Thanks in debian-changelog-mode.el. + + -- Peter S Galbraith Wed, 15 Oct 2003 21:55:34 -0400 + +emacs-goodies-el (22.0-1) unstable; urgency=low + + * Package `emacs-goodies-extra-el' now a transitional package. Its + contents are merged into `emacs-goodies-el'. + * New binary package `debian-el' holds contents of old `debbugs-el' (now + a transitional package) along with apt-sources.el and apt-utils.el + formely from `emacs-goodies-el'. + * New transitional package `debview' to replace old `debview' source + package since package debian-el now holds deb-view.el. ftp-masters, + please see bug #214311. + * New file in emacs-goodies-el: newsticker.el, a news ticker for Emacs. + * New file in emacs-goodies-el: framepop.el, display temporary buffers + in a dedicated frame. + * New file in emacs-goodies-el: session.el, a menu to restore files + visited in previous editing session. Thanks to Lennart Poettering for + suggesting it (Closes: #186639). + * Bug fix: "debian-el: debian-bug-search-file: should use dlocate when + available", thanks to Jeff Sheinberg (Closes: #211598). Added dlocate + to package Recommends. + * emacs-goodies-el: Since XEmacs has it's own version of ibuffer, make + sure we don't shadow it. Added its directory to load-path in + 50emacs-goodies-el.el. Also for ibuffer: a customization variable + (ibuffer-enable) was created to bind it to \C-x\C-b, and its + documentation was added to the emacs-goodies-el Info. + * emacs-goodies-el: dict.el new upstream version, merges in Debian patch. + * emacs-goodies-el: keywiz.el new upstream version 1.4. + * emacs-goodies-el: mutt-alis.el new upstream version 1.4. Almost + checkdoc clean. + * Bug fix: "emacs-goodies-el: perldoc does not work - terminal is not + fully functional due to perldoc setting a pager", thanks to Sebastian + Schütte for reporting and to Alan Shutko for + contributing the fix (Closes: #144963). + * emacs-goodies-el: perldoc.el rewrite to get Perl function name on the + fly from the perlfunc.pod file. + * debian-bug.el and debian-bts-control.el: Add `sarge-ignore' and + `fixed-upstream' tags. + * Junichi Uekawa + - devscripts-el: integrate upstream release (Closes: #208974). + pbuilder-log-view.el + pbuilder-mode.el + devscripts.el + - 7_devscripts-debuild-uc-us.dpatch devscripts incorporated upstream. + - 9_missing_provide.dpatch remove part about devscripts. + - devscripts-el: Depend on elserv. + + -- Peter S Galbraith Mon, 6 Oct 2003 20:16:42 -0400 + +emacs-goodies-el (21.12-1) unstable; urgency=low + + * emacs-goodies-el's highligh-current-line.el is now a minor-mode, + enhanced by yours truly. Add highlight-current-line to Info docs. + * emacs-goodies-el's highligh-beyond-fill-column.el: upstream approved + code cleanup. Created `highligh-beyond-fill-column' to activate it. + Added to Info docs. + * emacs-goodies-el's home-end.el: Bug fix: "home-end-enable shouldn't + unset end and home!", thanks to Jorgen Schäfer + (Closes: #211859). Add to Info docs. + * dpkg-dev-el: setup auto-mode-alist better for README.Debian and + copyright files. + + -- Peter S Galbraith Sat, 20 Sep 2003 19:49:55 -0400 + +emacs-goodies-el (21.11-1) unstable; urgency=low + + * dpkg-dev-el's debian-bts-control.el adds package', 'owner' and + 'noowner' commands. + + -- Peter S Galbraith Thu, 18 Sep 2003 22:40:53 -0400 + +emacs-goodies-el (21.10-1) unstable; urgency=low + + * debbugs-el's debian-bug.el: http://bugs.debian.org HTML code changed a + bit and broke my parser. Fixed. + + -- Peter S Galbraith Wed, 17 Sep 2003 20:41:19 -0400 + +emacs-goodies-el (21.9-1) unstable; urgency=low + + * debbugs: debian-bug-filename adds File: info to informational block in + draft bug report. + * debbugs, debbugs-el.emacsen-startup: Add autoload for useful + debian-bug-get-bug-as-email. + * dpkg-dev-el, debian-bts-control.el: debian-bts-help-control was missing! + * Bug fix: "Merge debian-bug-filename into debian-bug command proper", + thanks to Francesco Potorti` (Closes: #167214). (I'll do the + `commands' from the PATH later.) + * highlight-current-line.el: Updated to version V0.56 + * Update coffee.el to V0.3. + * dpkg-dev-el, debian-changelog-mode.el: Added browse-url link to `Best + Practices for debian/changelog' in menu. + * dpkg-dev-el, readme-debian.el bug fix: write-contents-hooks needed to + be made buffer-local explicitely in XEmacs ("Writes incorrect dates in + changelog", thanks to Ross Burton. Closes: #211382). + * patches/5_highlight-beyond-fill-column.dpatch: New patch to fix + indentation and remove extra fontified space. + + -- Peter S Galbraith Wed, 17 Sep 2003 15:30:25 -0400 + +emacs-goodies-el (21.8-1) unstable; urgency=low + + * Bug fix: "debian-bug should provide help when prompting for package + name and severity", thanks to Mathieu Roy (Closes: #200058). + * Bug fix: "dpkg-dev-el: debian-bts-control doesn't work on emacs20", + Don't set `debian-bts-control-verbose-prompts-flag' to t for Emacs20 + since it can't display multi-line prompts. (Closes: #208553). + * debbugs-el: Remove dependence on package `bug' since it no longer exists. + + -- Peter S Galbraith Wed, 3 Sep 2003 21:19:44 -0400 + +emacs-goodies-el (21.7-1) unstable; urgency=low + + * Standards-Version: 3.6.1 without changes. + * Bug fix: "dpkg-dev-el: readme-debian.el uses make-local-variable on a + hook", thanks to Kalle Olavi Niemitalo. Fixed upstream in + devscripts-el-0.0.20030825 (Closes: #206993). + * Bug fix: debian-changelog mode to support inserting bug title in + changlog entry, such as this entry right here. Thanks to Junichi + Uekawa (Closes: #207852). Updated dpkg-dev-el's + debian-changelog-mode.el and debbugs-el's debian-bug.el. + + -- Peter S Galbraith Tue, 2 Sep 2003 22:29:29 -0400 + +emacs-goodies-el (21.6-1) unstable; urgency=low + + * apt-utils.el: Updated to v1.54 (2003/06/24) + * debian-bts-control.el: add `debian-bts-control-prompt' to Prompt for + bug number using sensible default if found (closes: #193326). + * Add filladapt-turn-on-mode-hooks customization. + * ff-paths.el: Update to V3.21 + * *.emacsen-startup: Make sure that the uncompiled files are also in the + load-path, near the end. This is for moving point to the code when + view help. (closes: #189754) + + -- Peter S Galbraith Thu, 14 Aug 2003 22:45:06 -0400 + +emacs-goodies-el (21.5-1) unstable; urgency=low + + * patches/6_diminish-defcustom.dpatch: new defcustom tweaks sent + upstream. + * bar-cursor.el: A few tweaks also submitted upstream. + * dirvars.el: Update to v1.2. Add Info entry for it. + * ff-paths.el: Fix setup defcustoms. + * apt-utils.el: Updated to v1.54 (2003/06/22) + * debian-copyright.el: Handle font-lock-defaults such that XEmacs + doesn't fail on it (closes: #198601). + + -- Peter S Galbraith Tue, 24 Jun 2003 15:24:34 -0400 + +emacs-goodies-el (21.4-1) unstable; urgency=low + + * New maintainer. Thanks for all the work getting it this far Roland! + * dict.el: Updated to V1.27 + * Split elisp/ directory into subdirs for each binary package. + * emacs-goodies-loaddefs.el: Generate autoloads automatically from tags. + * Patch some upstream files to provide themseleves (closes: #197470) + * Add customize support to df.el and document in Info. + * ff-paths.el: don't install itself on load. Add a defcustom for that. + * Add many customize groups to `emacs-goodies-el' group. + + -- Peter S Galbraith Tue, 17 Jun 2003 21:56:11 -0400 + +emacs-goodies-el (21.3-1) unstable; urgency=low + + * apt-utils.el: Updated to v1.45 + * debian-bug.el: Add `d-i', `ipv6' and `lfs' tags. + * gnus-bonus-el.emacsen-install.in: Add directory of gnus elisp files to + load-path during byte-compilation (closes: #196816) + * dpkg-dev-el.emacsen-startup: Make file named changelog.dch load + debian-changelog-mode (closes: #196828) + * Moved readme-debian.el from package `devscripts-el' to `dpkg-dev-el' + such that all major modes for debian directory files are together. + * bar-cursor.el: Edited patch sent upstream to conform the Coding + Convention (don't enable simply by loading). + * Added 6_diminish-defcustom.dpatch, making diminish.el configurable + using the customize interface. Patch sent upstream. Also documented + file in Info. + + -- Peter S Galbraith Thu, 12 Jun 2003 22:02:55 -0400 + +emacs-goodies-el (21.2-1) unstable; urgency=low + + * Standards-Version: 3.5.10 + * debian-bts-control.el: Add `debian-bts-control-modes-to-reuse'. + * debian-bug.el: update to V1.42 + * Added 3_bar-cursor-customize.dpatch, making bar-cursor.el enables via + the customize interface. Patch submitted upstream. + * Added 5_bar-cursor-move-defcustom.dpatch, commented out the defcustom + which I have moved and edited into emacs-goodies-el.el. Documented in + Info. + * Update clipper.el to V1.1.1. + * Update browse-kill-ring.el to 1.2 (CVS). + * debian-control-mode.el: Add 'checklist to debian-control-visit-policy. + * debian-changelog-mode.el: Define (really) match-string-no-properties + for XEmacs (closes: #195181). + + -- Peter S Galbraith Thu, 29 May 2003 13:40:27 -0400 + +emacs-goodies-el (21.1-1) unstable; urgency=low + + * 50emacs-goodies-el.el: Add :link to Info manual in + `emacs-goodies-el-defaults' defcustom. + * debian-bug.el: Add `confirmed' tag (for debian-bts-control.el). + * debian/control: Added texinfo to Build-Depends-Indep for makeinfo + (closes: #193272) + * Updated debian-copyright.el from devscripts-el-0.0.20030521.tar.gz + * Updated readme-debian.el from devscripts-el-0.0.20030521.tar.gz, + patched it for font-lock on unstable's xemacs21, and to avoid the + error on the case of no timestamp. Also try to get newlines + surrounding the timestamp correctly. Sent the file upstream to become + the new upstream version. + * devscripts-el.emacsen-install.in: Use APPEND_LOAD_PATH to load + debian-changelog-mode.el during byte-compilation of readme-debian.el + * Deleted 3_readme-debian-automode.dpatch and 6_readme-debian.dpatch + * Updated services.el to upstream version CVS 1.4 + * Updated protocols.el to upstream version CVS 1.5 + * debian/control: Rephrase debian-bug.el description (closes: #193322) + * Move most of 50emacs-goodies-el.el into a required emacs-goodies-el.el + file, and wrap 50emacs-goodies-el.el around code testing if the + package is really installed or possibly removed (and not purged). + Same done for all other binary packages. + (closes: #193367) + + -- Peter S Galbraith Thu, 22 May 2003 21:41:51 -0400 + +emacs-goodies-el (21.0-1) unstable; urgency=low + + * Rename whitespace to nuke-trailing-whitespace.el (closes: #191527) + * Added file debian-bts-control.el to dpkg-dev-el. + * Add `add-hook' expression to 50emacs-goodies-el.el to setup wdired to + "r" key in dired-mode, since it can't really hurt anyway. + (closes: #156830) + * Update apt-sources.el to V0.9.7. + * Updated all.el to 5.2 (1997/03/04) from + ftp://ftp.dina.kvl.dk:/pub/Staff/Per.Abrahamsen/auctex/all.el + * Updated auto-fill-inhibit.el to latest upstream version (defcustom + patch that I submitted). + * Updated htmlize.el to V0.68. Remove 5_htmlize-noninteractive.dpatch + since it was integrated upstream. + * Added elisp/emacs-goodies-el.texi and install it in rules file. + (closes: #192303) + * 50emacs-goodies-el.el: Introduce defcustom group emacs-goodies-el to + allow full installation of packages that alter Emacs defaults. + (closes: #190177) + * Added debian-copyright.el CVS 1.6 from devscripts-el-0.0.20030512.tar.gz + to dpkg-dev-el. + * debian-changelog-mode: check if `debian-changelog-mode' is available + as a feature, and not simply the if the autoloaded are fboundp (which + is always true) (closes: #193085). + + -- Peter S Galbraith Mon, 12 May 2003 20:33:15 -0400 + +emacs-goodies-el (20.0-1) unstable; urgency=low + + * Make sure I include patches in debian diff. The last upload was built + without applying them! (closes: #191763) + * Added apt-utils.el to emacs-goodies-el package (closes: #169726) + + -- Peter S Galbraith Mon, 5 May 2003 20:59:17 -0400 + +emacs-goodies-el (19.5-1) unstable; urgency=low + + * debian-changelog-mode.el: defcustom added for debian-changelog-mode-hook + (closes: #190853). + * debian-bug.el: new upstream version. + * debian-changelog-mode.el: debian-changelog-add-version creates new + version in empty file (closes: #191285). + * xrdb-mode.el: New upstream version added font-lock-defaults for Emacs + (closes: #166874) + * No longer depend on emacsen-common, which forced it's very verbose + byte-compilation. Also output byte-compilation verbiage to a tempfile. + (closes: #185703) + + -- Peter S Galbraith Wed, 30 Apr 2003 22:40:40 -0400 + +emacs-goodies-el (19.4-1) unstable; urgency=low + + * debian-bug.el: Revert `send bug report to maintonly if priority wishlist or + minor change'. + * debian-bug.el: New buffer-local variable `debian-bug-open-alist' for + open bugs. New actions in Bugs list menu: can now read bug reports + as Email! + * debian-changelog-mode.el: Use `debian-bug-open-alist'. + * debian/control: dpkg-dev-el depends on debbugs-el (>= 19.4-1) for + `debian-bug-open-alist' and Email reading. + * debian-bug.el: Use executable-find. Patch contributed by Romain FRANCOISE + (closes: #189605). + * debian-bug.el (debian-bug): always build package list (closes: #186338) + * ff-paths.el: updated to V3.19 + * debian/emacsen-install.template: Use --no-site-file during + installation byte-compilation. + + -- Peter S Galbraith Tue, 22 Apr 2003 12:53:01 -0400 + +emacs-goodies-el (19.3-1) unstable; urgency=low + + * New upstream release for ff-paths.el (V3.18). + * Add Uploaders field for Peter Galbraith. + * debian-bug.el: send bug report to maintonly if priority wishlist or + minor (closes: #176429) + + -- Peter S Galbraith Fri, 11 Apr 2003 21:05:43 -0400 + +emacs-goodies-el (19.2-1) unstable; urgency=low + + * New upstream release for debian-bug.el (1.35) (closes: #173040, + #184954). + + -- Roland Mas Fri, 28 Mar 2003 13:19:47 +0100 + +emacs-goodies-el (19.1-1) unstable; urgency=low + + * New upstream release for debian-bug.el (1.35). + + -- Roland Mas Wed, 19 Mar 2003 22:33:55 +0100 + +emacs-goodies-el (19-3) unstable; urgency=low + + * Patch #7_devscripts-debuild-uc-us: the arguments to debuild need to be + in separate strings (closes: #185154) (yes, again). + + -- Roland Mas Wed, 19 Mar 2003 22:05:10 +0100 + +emacs-goodies-el (19-2) unstable; urgency=low + + * Patch #5_htmlize-noninteractive: fix htmlize.el in non-interactive + mode thanks to Junichi Uekawa's patch (closes: #166587). + * Patch #6_readme-debian: fix readme-debian.el failing to load some + README.Debian files thanks to James LewisMoss's patch (closes: + #167575). + * Favor reportbug over bug (closes: #184020). + * Patch #4_dict-pager: invoke with appropriate pager options (closes: + #174661). + * Patch #7_devscripts-debuild-uc-us: invoke debuild with "-uc -us" + parameters, so as not to ask for a passphrase (closes: #185154). + + -- Roland Mas Wed, 19 Mar 2003 15:28:25 +0100 + +emacs-goodies-el (19-1) unstable; urgency=low + + * Now using dpatch to apply patches at build time. Much better than the + previous hand-made system. + * Patch #4_dict-pager: dict.el patched to invoke dict with --pager + (closes: #174661). + * Removed nnmaildir.el, now included in Gnus (closes: #154396). + + -- Roland Mas Wed, 19 Feb 2003 13:46:08 +0100 + +emacs-goodies-el (18.2-1) unstable; urgency=low + + * Fix autoload for dict.el (closes: #173143). + * Made README.Debian more explicit: it documents all files, not just the + ones in emacs-goodies-el (closes: #172335). + * New upstream release for debian-bug.el (1.34) (closes: #168811). + * Bumped Standards-Version to 3.5.8. + + -- Roland Mas Tue, 17 Dec 2002 19:30:10 +0100 + +emacs-goodies-el (18.1-2) unstable; urgency=low + + * Changing sections to resolve override disparity. + * Explicitly use the Bash shebang, since the installation scripts use + bashisms (closes: #166310). + * Fix load-path for dpkg-dev-el (closes: #166586). + + -- Roland Mas Tue, 12 Nov 2002 20:05:48 +0100 + +emacs-goodies-el (18.1-1) unstable; urgency=low + + * New upstream release for thinks.el (1.8). + * New upstream release for debian-changelog-mode.el (1.66) adds new + distribution (closes: #166163). + + -- Roland Mas Thu, 24 Oct 2002 18:34:22 +0200 + +emacs-goodies-el (18-1) unstable; urgency=low + + * New binary package: devscripts-el. It currently includes + devscripts.el and readme-debian.el, both at version 0.0.20021016. + * Also changed the build process a bit: *.emacsen-install and + *.emacsen-remove files are now built from *.in files. Since most of + the files are identical save for the package name and a few other + variables at the beginning, let's put that shared code into a separate + unique file. + * Added sys-apropos.el (no version, taken at 2002-10-17). + * New packages merged in: debbugs-el and dpkg-dev-el. That should be + all for now. The previous changelogs are included at the bottom of + this file. Search for "8-merged-debbugs-el" or "3-merged-dpkg-dev-el" + to get to their beginnings. + + -- Roland Mas Sun, 20 Oct 2002 15:12:37 +0200 + +emacs-goodies-el (17-1) unstable; urgency=low + + * Merged the emacs-goodies-el and gnus-bonus-el source packages into one + (named emacs-goodies-el). + * The changelog of what happened to the gnus-goodies-el package before + this merger happened is kept for reference at the bottom of this + changelog file. Search for the "4-merged-gnus-bonus-el" string to get + to its beginning. + * While I was at it, I created a new package, emacs-goodies-extra-el, so + that interesting files with extra dependencies can still be included. + Beware, this package is likely to have a growing list of dependencies. + But that also means that I'm going to start accepting files with + external dependencies into this source package (under the condition + that they be available as Debian packages in the "main" section). + * emacs-goodies-extra-el: added dict.el (1.25). + + -- Roland Mas Mon, 14 Oct 2002 21:17:10 +0200 + +emacs-goodies-el (16.1-1) unstable; urgency=low + + * New upstream release for boxquote.el (1.16) (closes: #163834). + * New upstream release for wdired.el (1.9.2pre2) (closes: #161157). + * Fixed the auto-mode for xrdb-mode.el (closes: #161563). + + -- Roland Mas Wed, 9 Oct 2002 13:55:22 +0200 + +emacs-goodies-el (16-1) unstable; urgency=low + + * Added home-end.el (2002-07-12) (closes: #152725), with proposed + patch. + * Added xrdb-mode.el (2.28) (closes: #154039). + * Added map-lines.el (0.1). + * Also cleaned up the patching system a bit. + + -- Roland Mas Fri, 13 Sep 2002 17:05:51 +0200 + +emacs-goodies-el (15.1-1) unstable; urgency=low + + * Bumped Standards-Version to 3.5.7. + * Sorted the list of files in the package description (closes: #160017). + * New upstream release for muttrc-mode.el (2.5). + * Started using a (very) light patching system. First patch is + 500muttrc-manual, so that the file that muttrc-mode.el opens actually + exists (closes: #158571). + * Also cleaned debian/rules a bit. + + -- Roland Mas Mon, 9 Sep 2002 19:40:19 +0200 + +emacs-goodies-el (15-1) unstable; urgency=low + + * Added muttrc-mode.el (2.4) (closes: #146780). + * Added ibuffer.el (2.6) (closes: #134086). + * Fixed emacsen-install script again (closes: #158480). + + -- Roland Mas Tue, 27 Aug 2002 20:19:24 +0200 + +emacs-goodies-el (14-2) unstable; urgency=low + + * Depend on a recent bash, since we use features not available in old + ones. + * Also fixed the emacs-goodies-el.emacsen-install script so that it + won't forget files that are excluded in other flavours than the + current one (closes: #149921). + + -- Roland Mas Mon, 26 Aug 2002 13:46:01 +0200 + +emacs-goodies-el (14-1) unstable; urgency=low + + * The "Elmo owes me one" release. + * Added apt-sources.el (0.9.5). + + -- Roland Mas Wed, 21 Aug 2002 13:37:56 +0200 + +emacs-goodies-el (13-1) unstable; urgency=low + + * Added tc.el (0.12.3) (closes: #122243). + * New upstream release for keywiz.el (1.2). + * New upstream release for browse-kill-ring.el (1.0). + * New upstream release for boxquote.el (1.8). + + -- Roland Mas Thu, 2 May 2002 14:01:00 +0200 + +emacs-goodies-el (12.1-1) unstable; urgency=low + + * New upstream release for boxquote.el (1.7). + + -- Roland Mas Fri, 19 Apr 2002 19:07:15 +0200 + +emacs-goodies-el (12-1) unstable; urgency=low + + * Added keywiz.el (1.1) (closes: #143072). + * Added table.el (1.5.48) (closes: #124119). + + -- Roland Mas Fri, 19 Apr 2002 18:53:54 +0200 + +emacs-goodies-el (11-2) unstable; urgency=low + + * Excluded todoo.el from Xemacs 21. + + -- Roland Mas Wed, 17 Apr 2002 14:00:29 +0200 + +emacs-goodies-el (11-1) unstable; urgency=low + + * Added all.el (0.0), toggle-option.el (1.0), todoo.el (1.2), + cyclebuffer.el (1.2). + + -- Roland Mas Tue, 16 Apr 2002 19:33:07 +0200 + +emacs-goodies-el (10-3) unstable; urgency=low + + * Fixed emacsen-install script (closes: #134778). It's a bashism, but + I'm too lazy to POSIXise it (I'm not even sure it can be POSIXised), + so I just change the shebang. + + -- Roland Mas Thu, 21 Feb 2002 18:47:25 +0100 + +emacs-goodies-el (10-2) unstable; urgency=low + + * Fixed README.Debian to mention the problem with Emacs 21 and + whitespace.el. + + -- Roland Mas Mon, 18 Feb 2002 13:12:38 +0100 + +emacs-goodies-el (10-1) unstable; urgency=low + + * Added ff-paths.el (3.17), dirvars.el (1.0), perldoc.el (1.1). + * Patched emacsen-install to support flavor-dependent lists of files to + include/exclude. + * Use debian-pkg-add-load-path-item if available. + * Renamed (with wdired and rect ;-) the debian/emacsen-* files into + debian/emacs-goodies-el.emacsen-*. Because I can, and also because of + a Secret Plan I have. + * Disabled whitespace.el for Emacs 21 (closes: #133014). I'd like to + find a better solution fot this, but I haven't thought of it yet. + + -- Roland Mas Mon, 18 Feb 2002 12:55:51 +0100 + +emacs-goodies-el (9-1) unstable; urgency=low + + * Added highlight-current-line.el (0.5), align-string.el (0.1) (closes: + #113283), diminish.el (0.44), htmlize.el (0.62) and keydef.el (1.16). + + -- Roland Mas Fri, 4 Jan 2002 21:10:06 +0100 + +emacs-goodies-el (8-2) unstable; urgency=low + + * Fixed speling error in Description: field (closes: #124598). + + -- Roland Mas Tue, 18 Dec 2001 10:11:42 +0100 + +emacs-goodies-el (8-1) unstable; urgency=low + + * Added under.el (1.2). + + -- Roland Mas Fri, 7 Dec 2001 22:50:20 +0100 + +emacs-goodies-el (7.1-1) unstable; urgency=low + + * New upstream release for egocentric.el (1.1). + * New upstream release for df.el (1.8) (closes: #122805). + + -- Roland Mas Fri, 7 Dec 2001 21:48:22 +0100 + +emacs-goodies-el (7-1) unstable; urgency=low + + * Added toggle-case.el (1.4), tail.el (1.1), df.el (1.7), egocentric.el + (not versioned, taken on 2001-12-04) and initsplit.el (1.6). + + -- Roland Mas Wed, 5 Dec 2001 22:44:17 +0100 + +emacs-goodies-el (6-2) unstable; urgency=low + + * Fixed README.Debian to document the recent apparition of + highlight-beyond-fill-column.el. + + -- Roland Mas Thu, 29 Nov 2001 21:54:30 +0100 + +emacs-goodies-el (6-1) unstable; urgency=low + + * Added highlight-beyond-fill-column.el (1.1). + + -- Roland Mas Wed, 21 Nov 2001 22:55:35 +0100 + +emacs-goodies-el (5.1-1) unstable; urgency=low + + * New upstream release for wdired.el (1.91). + + -- Roland Mas Mon, 19 Nov 2001 14:44:35 +0100 + +emacs-goodies-el (5-1) unstable; urgency=low + + * Added wdired.el (1.9), floatbg.el (0.5), clipper.el (1.1.0), + projects.el, auto-fill-inhibit.el (20011114). + + -- Roland Mas Sat, 17 Nov 2001 17:33:49 +0100 + +emacs-goodies-el (4-3) unstable; urgency=low + + * debian/emacsen-startup: fix typo (closes: #116855). + + -- Roland Mas Wed, 24 Oct 2001 09:19:17 +0200 + +emacs-goodies-el (4-2) unstable; urgency=low + + * debian/control: changed Description: field to reflect the recent + additions. + + -- Roland Mas Mon, 22 Oct 2001 11:33:32 +0200 + +emacs-goodies-el (4-1) unstable; urgency=low + + * Added filladapt.el (2.12) (closes: #111383), setnu.el (1.06). + * debian/control: changed Build-Depends: to Build-Depends-Indep:. + + -- Roland Mas Sun, 21 Oct 2001 16:15:15 +0200 + +emacs-goodies-el (3.1-2) unstable; urgency=low + + * Changed debian/control formatting (closes: #110053). + + -- Roland Mas Sun, 9 Sep 2001 18:34:21 +0200 + +emacs-goodies-el (3.1-1) unstable; urgency=low + + * Upgraded browse-kill-ring.el to 0.9. + + -- Roland Mas Mon, 27 Aug 2001 18:53:32 +0200 + +emacs-goodies-el (3-1) unstable; urgency=low + + * Added browse-kill-ring.el (0.8), coffee.el (0.2), twiddle.el (1.3), + whitespace.el (1.9), silly-mail.el (1.22), obfusurl.el (1.5), + toggle-buffer.el (1.1), mutt-alias.el (1.2), protbuf.el (1.7). + + -- Roland Mas Fri, 24 Aug 2001 18:10:38 +0200 + +emacs-goodies-el (2.0-2) unstable; urgency=low + + * Fixed package description in the control file. + + -- Roland Mas Thu, 23 Aug 2001 17:27:02 +0200 + +emacs-goodies-el (2.0-1) unstable; urgency=low + + * Added bar-cursor.el (1.1), tld.el (1.3), services.el (1.2), + protocols.el (1.3) and highlight-completion.el (0.06). + + -- Roland Mas Thu, 23 Aug 2001 12:27:51 +0200 + +emacs-goodies-el (1.0-1) unstable; urgency=low + + * Initial Release. + * Contents: boxquote.el (1.6) and thinks.el (1.6). + + -- Roland Mas Tue, 21 Aug 2001 22:09:45 +0200 + +gnus-bonus-el (4-merged-gnus-bonus-el) unstable; urgency=low + + * This is the version that never happened. The gnus-bonus-el source + package was merged into emacs-goodies version 17. They still generate + different binary packages, though. The following changelog entries + (down there in this file) are only here for reference. + + -- Roland Mas Sun, 13 Oct 2002 23:17:45 +0200 + +gnus-bonus-el (3.1-1) unstable; urgency=low + + * New upstream version for spam-stat.el (0.1.0). + * Bumped Standards-Version to 3.5.7. + + -- Roland Mas Fri, 6 Sep 2002 18:31:21 +0200 + +gnus-bonus-el (3-1) unstable; urgency=low + + * Added spam-stat.el (0.0.4) and gnus-outlook-deuglify.el (1.2). + + -- Roland Mas Mon, 26 Aug 2002 22:51:50 +0200 + +gnus-bonus-el (2-3) unstable; urgency=low + + * Applied patch from Michael Hummel to fix nnir.el + with respect to swish++ (closes: #133278). + + -- Roland Mas Thu, 7 Mar 2002 13:12:21 +0100 + +gnus-bonus-el (2-2) unstable; urgency=low + + * Changed Depends: field so that the gnus package is not required (since + Gnus is included in the emacs21, emacs20 and xemacs21 packages) + (closes: #127792). + + -- Roland Mas Fri, 4 Jan 2002 18:28:49 +0100 + +gnus-bonus-el (2-1) unstable; urgency=low + + * Added nnir.el (1.73), nnmaildir.el (2001.09.11). + + -- Roland Mas Sat, 15 Dec 2001 21:01:50 +0100 + +gnus-bonus-el (1-1) unstable; urgency=low + + * Initial Release. + * Contents: gnus-junk.el (0.23), nnnil.el (not versioned, taken at + 2001-12-04), nntodo.el (1.1), mesage-x.el (1.23). + + -- Roland Mas Tue, 4 Dec 2001 14:17:50 +0100 + +debbugs-el (8-merged-debbugs-el) unstable; urgency=low + + * This is the version that never happened. The debbugs-el source + package was merged into emacs-goodies-el version 18. They still + generate different binary packages, though. The following changelog + entries (down there in this file) are only here for reference. + + -- Roland Mas Sun, 20 Oct 2002 15:11:56 +0200 + +debbugs-el (7.12-1) unstable; urgency=low + + * New upstream version for debian-bug.el (1.33) allows the menus to be + split according to severity (closes: #161155). + * Bumped DH_COMPAT to 4. + + -- Roland Mas Wed, 2 Oct 2002 13:50:53 +0200 + +debbugs-el (7.11-1) unstable; urgency=low + + * New upstream version for debian-bug.el (1.32) fixes several bugs + (closes: #159625, #160750). + + -- Roland Mas Fri, 13 Sep 2002 17:14:19 +0200 + +debbugs-el (7.10-4) unstable; urgency=low + + * Fixed the fix in 7.10-3. The flavour-independent component is needed, + only I have to make it lower priority than the flavour-dependent + component (closes: #159624). + * Versioned Depends: on emacsen-common, so that we can get rid of the + old compatibility code in the emacsen-startup file. + * Bumped Standards-Version to 3.5.7. + + -- Roland Mas Mon, 9 Sep 2002 13:32:55 +0200 + +debbugs-el (7.10-3) unstable; urgency=low + + * Fixed the load-path fiddling, so that the byte-compiled *.elc files + are used instead of the non-compiled *.el files (closes: #159624). + + -- Roland Mas Fri, 6 Sep 2002 13:38:03 +0200 + +debbugs-el (7.10-2) unstable; urgency=low + + * Force compression of the compilation log, to allow for non-interactive + installation (closes: #157798). + + -- Roland Mas Thu, 22 Aug 2002 12:48:42 +0200 + +debbugs-el (7.10-1) unstable; urgency=low + + * New upstream release for debian-bug.el (1.31) fixes several bugs + (closes: #117036, #156297, #156391). + + -- Roland Mas Tue, 20 Aug 2002 14:27:41 +0200 + +debbugs-el (7.9-1) unstable; urgency=low + + * New upstream release for debian-bug.el (1.27) (closes: #151717). + * Slightly patched gnus-BTS.el to allow other Elisp programs to + "require" it (closes: #151718). + + -- Roland Mas Fri, 12 Jul 2002 12:20:10 +0200 + +debbugs-el (7.8-3) unstable; urgency=low + + * Cosmetic changes to installation (closes: #124056). + + -- Roland Mas Tue, 9 Apr 2002 14:25:55 +0200 + +debbugs-el (7.8-2) unstable; urgency=low + + * Changed the way I call debian-pkg-add-load-path-item, since it doesn't + change the contents of the load-path variable as I thought it did + (closes: #134392). + + -- Roland Mas Sun, 17 Feb 2002 21:22:03 +0100 + +debbugs-el (7.8-1) unstable; urgency=low + + * New upstream release for debian-bug.el (1.26). + * Use debian-pkg-add-load-path-item if available. + * Wrapped the .emacsen-startup file into a test for the installedness of + the package, to prevent nasty stuff from happening when the package is + uninstalled but not purged (closes: #134096). + + -- Roland Mas Fri, 15 Feb 2002 21:26:18 +0100 + +debbugs-el (7.7-1) unstable; urgency=low + + * New upstream release for debian-bug.el (1.23). + * This release uses a new feature of reportbug, hence the versioned + Depends: field. (closes: #122032). + + -- Roland Mas Fri, 14 Dec 2001 13:58:38 +0100 + +debbugs-el (7.6-1) unstable; urgency=low + + * New upstream release for debian-bug.el (1.22) (closes: #122033, + #121932, #123476). + * Also fixed the autoload docstring for #121932. + + -- Roland Mas Wed, 12 Dec 2001 12:22:25 +0100 + +debbugs-el (7.5-1) unstable; urgency=low + + * New upstream release for debian-bug.el (1.19) (closes: #117976, + #117855, #117842). + + -- Roland Mas Thu, 8 Nov 2001 18:50:03 +0100 + +debbugs-el (7.4-1) unstable; urgency=low + + * ACK NMU by Peter (closes: #111615). + * New upstream version for debian-bug.el (1.17) (closes: #111332). + + -- Roland Mas Sun, 21 Oct 2001 14:32:01 +0200 + +debbugs-el (7.3-1) unstable; urgency=low + + * NMU by debian-bug.el upstream maintainer (Roland is on vacation). + * New upstream release for debian-bug.el (1.16). + - Includes template for ITP/RPC bugs lifted from reportbug (closes: #111615). + - Work around bug #111331 (function font-lock-add-keywords doesn't exist + in XEmacs) temporarily. There's no fontification in XEmacs, but at + least the code loads. I'll close the bug when it's actually fixed. + + -- Peter S Galbraith Fri, 21 Sep 2001 16:18:07 -0400 + +debbugs-el (7.2-2) unstable; urgency=low + + * Removed version numbers from package description. + + -- Roland Mas Thu, 16 Aug 2001 16:46:02 +0200 + +debbugs-el (7.2-1) unstable; urgency=low + + * New upstream release for debian-bug.el (1.15). + * 1.14 release also increased consistency in function naming scheme + (closes: #108808). + * Now Recommends: wget. + + -- Roland Mas Thu, 16 Aug 2001 11:43:45 +0200 + +debbugs-el (7.1-1) unstable; urgency=low + + * New upstream release for debian-bug.el (1.13). + * Changed Depends: line (closes: #108804). + + -- Roland Mas Wed, 15 Aug 2001 18:56:01 +0200 + +debbugs-el (7.0-1) unstable; urgency=low + + * Changed numbering scheme: major will change when adding or removing + files to this package; minor will change when these files have a new + upstream release; Debian revision is for packaging only. + * deban-bug.el: new upstream release 1.12 (new upstream maintainer is + Peter S Galbraith ). + * Added autoloads for debian-bug.el. + + -- Roland Mas Wed, 15 Aug 2001 09:41:50 +0200 + +debbugs-el (6) unstable; urgency=low + + * gnus-BTS.el: made the regexps that recognise a Debian group a bit more + permissive. + * debian-bug.el: mark the bug reporting buffer as non-modified after + initialisation (Toby Speight ) (closes: #95372). + + -- Roland Mas Fri, 27 Apr 2001 18:07:05 +0200 + +debbugs-el (5) unstable; urgency=low + + * Fixed load-path problem for gnus-BTS.el (closes: #93334). + + -- Roland Mas Sat, 21 Apr 2001 17:12:56 +0200 + +debbugs-el (4) unstable; urgency=low + + * Removed compilation of gnus-BTS.el to avoid undefined problems with + undefined macros. (closes: #89838) + + -- Roland Mas Fri, 30 Mar 2001 18:36:00 +0200 + +debbugs-el (3) unstable; urgency=low + + * Added Depends: bug to control file (closes: #89357) + + -- Roland Mas Mon, 12 Mar 2001 20:20:35 +0100 + +debbugs-el (2) unstable; urgency=low + + * New upstream release for gnus-BTS.el: copyright assignment is changed, + Xemacs dependency is dead, more BTS keywords, regex cleanup, + etc. (closes: #88294). + + -- Roland Mas Sun, 11 Mar 2001 19:27:16 +0100 + +debbugs-el (1) unstable; urgency=low + + * Initial Release. + * Includes debian-bug.el and gnus-BTS.el (closes: #85883, #85974). + + -- Roland Mas Tue, 27 Feb 2001 20:57:06 +0100 + +dpkg-dev-el (3-merged-dpkg-dev-el) unstable; urgency=low + + * This is the version that never happened. The dpkg-dev-el source + package was merged into emacs-goodies-el version 18. They still + generate different binary packages, though. The following changelog + entries (down there in this file) are only here for reference. + + -- Roland Mas Sun, 20 Oct 2002 15:11:56 +0200 + +dpkg-dev-el (2.9-1) unstable; urgency=low + + * New upstream version for debian-changelog-mode.el (1.65). + * Bumped Standards-Version to 3.5.7. + + -- Roland Mas Fri, 6 Sep 2002 16:24:28 +0200 + +dpkg-dev-el (2.8-1) unstable; urgency=low + + * New upstream version for debian-changelog-mode.el (1.64), fixes + several bugs (closes: #159041, #159643). + + -- Roland Mas Fri, 6 Sep 2002 08:56:29 +0200 + +dpkg-dev-el (2.7-2) unstable; urgency=low + + * Changed the load-path used at install time, to fix installation + problem on Xemacs (closes: #157811). + + -- Roland Mas Thu, 22 Aug 2002 15:38:07 +0200 + +dpkg-dev-el (2.7-1) unstable; urgency=low + + * Now depends on debbugs-el. + * New upstream version for debian-changelog-mode.el (1.62) fixes several + bugs (closes: #113964, #156762). + + -- Roland Mas Wed, 21 Aug 2002 09:33:27 +0200 + +dpkg-dev-el (2.6-1) unstable; urgency=low + + * New upstream release for debian-changelog-mode.el (1.57) (closes: #154747). + + -- Roland Mas Tue, 30 Jul 2002 08:40:12 +0200 + +dpkg-dev-el (2.5-1) unstable; urgency=low + + * New upstream release for debian-changelog-mode.el (1.56) (closes: #153982). + + -- Roland Mas Thu, 25 Jul 2002 17:09:15 +0200 + +dpkg-dev-el (2.4-1) unstable; urgency=low + + * The "Yeah, I know I'm late" release. + * Acknowledging the NMU. Thanks, Colin. + * New upstream release for debian-changelog-mode.el (1.55) (closes: #146583) + + -- Roland Mas Mon, 15 Jul 2002 13:57:45 +0200 + +dpkg-dev-el (2.3-1) unstable; urgency=medium + + * NMU + * New upstream release for debian-control-mode.el (0.4). + + -- Colin Walters Fri, 31 May 2002 16:15:50 -0400 + +dpkg-dev-el (2.2-2) unstable; urgency=low + + * Changed the way I call debian-pkg-add-load-path-item, since it doesn't + change the contents of the load-path variable as I thought it did. + + -- Roland Mas Sun, 17 Feb 2002 21:51:29 +0100 + +dpkg-dev-el (2.2-1) unstable; urgency=low + + * New upstream release for debian-control-mode.el (0.3). + * New upstream release for debian-changelog-mode (1.52). + * Use debian-pkg-add-load-path-item if available. + + -- Roland Mas Tue, 12 Feb 2002 22:53:20 +0100 + +dpkg-dev-el (2.1-1) unstable; urgency=low + + * New upstream (bugfix) release for debian-control-mode.el (0.2). + + -- Roland Mas Mon, 3 Dec 2001 13:51:48 +0100 + +dpkg-dev-el (2-1) unstable; urgency=low + + * Added debian-control-mode.el (0.1) (closes: #121690). Cool, that + means I was right in calling the package dpkg-dev-el and not just + debian-changelog-mode-el. + * Changed numbering scheme, see README.Debian. + * Also added magic in emacsen-startup so that emacsen-startup files load + in Emacs Lisp mode, as they should, and no more in Fundamental mode. + * New upstream release for debian-changelog-mode.el (1.50). + + -- Roland Mas Fri, 30 Nov 2001 11:00:25 +0100 + +dpkg-dev-el (1.49-1) unstable; urgency=low + + * New upstream release. + * Fiddled with debian/control a bit. + + -- Roland Mas Thu, 22 Nov 2001 19:01:24 +0100 + +dpkg-dev-el (1.48-1) unstable; urgency=low + + * NMU by upstream author (Roland is on vacation). + * New upstream release. + + -- Peter S Galbraith Wed, 19 Sep 2001 11:38:59 -0400 + +dpkg-dev-el (1.47-2) unstable; urgency=low + + * Added the appropriate load-path (closes: #111702). + + -- Roland Mas Sun, 9 Sep 2001 18:36:53 +0200 + +dpkg-dev-el (1.47-1) unstable; urgency=low + + * New upstream release. + + -- Roland Mas Wed, 15 Aug 2001 21:02:43 +0200 + +dpkg-dev-el (1.46-1) unstable; urgency=low + + * New upstream release. + * Fix font-lock code (closes: #108809). + * New feature requires a Recommends: wget. + + -- Roland Mas Wed, 15 Aug 2001 19:38:04 +0200 + +dpkg-dev-el (1.44-2) unstable; urgency=low + + * Minor copyright tweaks. + + -- Roland Mas Sun, 5 Aug 2001 17:49:37 +0200 + +dpkg-dev-el (1.44-1) unstable; urgency=low + + * New upstream release. + * Added autoloads for the debian-changelog-web-* functions (except for + d-c-w-this-bug-under-mouse). + + -- Roland Mas Fri, 27 Jul 2001 18:55:48 +0200 + +dpkg-dev-el (1.43-1) unstable; urgency=low + + * New upstream release. + * Updated to policy 3.5.6.0. + * Added hook to find-file-hooks to switch to debian-changelog-mode for + files that look like some Debian changelog, even if that can't be + decided from the file name (closes: #105889). + + -- Roland Mas Thu, 26 Jul 2001 10:00:35 +0200 + +dpkg-dev-el (1.42-1) unstable; urgency=low + + * New upstream release (closes: #102088). + + -- Roland Mas Thu, 12 Jul 2001 13:39:08 +0200 + +dpkg-dev-el (1.40-1) unstable; urgency=low + + * New upstream release. + + -- Roland Mas Wed, 27 Jun 2001 09:49:22 +0200 + +dpkg-dev-el (1.39-1) unstable; urgency=low + + * New upstream release (closes: #100639). + + -- Roland Mas Fri, 15 Jun 2001 09:51:39 +0200 + +dpkg-dev-el (1.37-1) unstable; urgency=low + + * New upstream release (closes: #100162). + + -- Roland Mas Tue, 12 Jun 2001 09:45:11 +0200 + +dpkg-dev-el (1.34-1) unstable; urgency=low + + * New upstream release (closes: #99051). + + -- Roland Mas Tue, 29 May 2001 18:08:43 +0200 + +dpkg-dev-el (1.33-1) unstable; urgency=low + + * New upstream release. Should fix problems with Xemacs. Yes, again. + + -- Roland Mas Tue, 29 May 2001 15:53:59 +0200 + +dpkg-dev-el (1.32-1) unstable; urgency=low + + * New upstream release. Should fix problems with Xemacs. + * The "Not another shrubbery!" release. + + -- Roland Mas Tue, 29 May 2001 09:30:56 +0200 + +dpkg-dev-el (1.31-1) unstable; urgency=low + + * New upstream release (closes: #98577). + + -- Roland Mas Mon, 28 May 2001 19:00:36 +0200 + +dpkg-dev-el (1.30-1) unstable; urgency=low + + * New upstream release. + * Default to the same distribution as the previous release, as requested + (closes: #96260). + + -- Roland Mas Wed, 9 May 2001 21:47:05 +0200 + +dpkg-dev-el (1.24-1) unstable; urgency=low + + * New upstream release. + * The "I'm going to start a strike" release. + + -- Roland Mas Thu, 3 May 2001 19:20:17 +0200 + +dpkg-dev-el (1.23-1) unstable; urgency=low + + * New upstream release. + * The "there, see what happens?" release. + + -- Roland Mas Thu, 3 May 2001 13:00:06 +0200 + +dpkg-dev-el (1.22-1) unstable; urgency=low + + * The "would someone please slow him down?" release. + * New upstream release. Yes, *again* :-) + + -- Roland Mas Wed, 2 May 2001 19:34:05 +0200 + +dpkg-dev-el (1.19-1) unstable; urgency=low + + * New upstream releases seem to pop up faster than I can track them. + This one is 1.19 (closes: #95831). + * Fix the startup script (yes, again) (closes: #95830). + + -- Roland Mas Wed, 2 May 2001 14:08:01 +0200 + +dpkg-dev-el (1.13-1) unstable; urgency=low + + * New upstream release. + * Less flashy colouring (closes: #93243). + * Less verbosity during byte-compilation (closes: #95347). + * Some fixes in the startup script (closes: #95348). + + -- Roland Mas Fri, 27 Apr 2001 20:12:57 +0200 + +dpkg-dev-el (1.10-1) unstable; urgency=low + + * New upstream release. + * Fix number suggestion scheme (closes: #88245, #88589). + * add-log-mailing-address is now (since 1.06 in fact) + debian-changelog-mailing-address (closes: #89208). + + -- Roland Mas Sun, 11 Mar 2001 18:33:11 +0100 + +dpkg-dev-el (1.07-1) unstable; urgency=low + + * New upstream release. + * Handle epochs correctly (closes: #87964). + * Make lintian happy. + + -- Roland Mas Wed, 28 Feb 2001 17:24:38 +0100 + +dpkg-dev-el (1.05-1) unstable; urgency=low + + * New upstream release. Closes: #85412. + + -- Roland Mas Mon, 26 Feb 2001 09:38:34 +0100 + +dpkg-dev-el (1.01-4) unstable; urgency=low + + * Changed Description: field again (Closes: #85413). + + -- Roland Mas Sat, 10 Feb 2001 14:19:34 +0100 + +dpkg-dev-el (1.01-3) unstable; urgency=low + + * Changed Description: field and maintainer address. + + -- Roland Mas Wed, 24 Jan 2001 12:55:53 +0100 + +dpkg-dev-el (1.01-2) unstable; urgency=low + + * Changed Depends: to Suggests: + + -- Roland Mas <99.roland.mas@aist.enst.fr> Tue, 9 Jan 2001 09:54:34 +0100 + +dpkg-dev-el (1.01-1) unstable; urgency=low + + * Initial Release. + + -- Roland Mas <99.roland.mas@aist.enst.fr> Fri, 22 Dec 2000 14:09:40 +0100 diff --git a/debian/compat b/debian/compat new file mode 100644 index 0000000..ec63514 --- /dev/null +++ b/debian/compat @@ -0,0 +1 @@ +9 diff --git a/debian/control b/debian/control new file mode 100644 index 0000000..4781fc8 --- /dev/null +++ b/debian/control @@ -0,0 +1,152 @@ +Source: emacs-goodies-el +Section: editors +Priority: optional +Maintainer: Peter S Galbraith +Uploaders: Julian Gilbey +Build-Depends: debhelper (>= 9), quilt, texinfo +Standards-Version: 3.9.5 +Vcs-Cvs: :pserver:anonymous@cvs.alioth.debian.org:/cvs/pkg-goodies-el emacs-goodies-el +Vcs-Browser: http://alioth.debian.org/scm/viewvc.php/?root=pkg-goodies-el + +Package: emacs-goodies-el +Architecture: all +Depends: emacs | emacsen, emacsen-common (>= 2.0.8), bash (>= 2.05a) | bash-static, ${misc:Depends}, dpkg (>= 1.15.4) | install-info +Recommends: wget, perl-doc +Replaces: emacs-goodies-extra-el +Provides: emacs-goodies-extra-el +Description: Miscellaneous add-ons for Emacs + This package contains: + align-string - align string components over several lines; + all - edit all lines matching a given regexp; + apache-mode - major mode for editing Apache configuration files; + ascii - ASCII code display for character under point; + auto-fill-inhibit - finer grained control over auto-fill-mode; + bar-cursor - change your cursor to a bar instead of a block; + bm - visible bookmarks in buffers; + boxquote - quote texts in nice boxes; + browse-huge-tar - browse tar files without reading them into memory; + browse-kill-ring - browse, search, modify the kill ring; + button-lock - clickable text defined by regular expression; + clipper - save strings of data for further use; + coffee - now Emacs can even brew coffee; + color-theme - changes the colors used within Emacs; + csv-mode - major mode for comma-separated value files; + ctypes - enhanced Font lock support for custom defined types; + dedicated - make a window dedicated to a single buffer; + df - display in the mode line space left on devices; + diminish - shorten or erase modeline presence of minor modes; + dir-locals - provides directory-wide local variables; + edit-env - display, edit, delete and add environment variables; + egocentric - highlight your name inside emacs buffers; + eproject - assign files to projects, programatically + ff-paths - $PATH-like searching in C-x C-f; + filladapt - enhances Emacs's built-in adaptive fill; + floatbg - slowly modify background color; + framepop - display temporary buffers in a dedicated frame; + graphviz-dot-mode.el - mode for the dot-language used by graphviz (att). + highlight-beyond-fill-column - highlight lines that are too long; + highlight-completion - highlight completions in the minibuffer; + highlight-current-line - highlight line where the cursor is; + home-end - alternative Home and End commands; + htmlize - HTML-ize font-lock buffers; + initsplit - split customizations into different files; + joc-toggle-buffer - fast switching between two buffers; + joc-toggle-case - a set of functions to toggle the case of characters; + keydef - a simpler way to define key mappings; + keywiz - Emacs key sequence quiz; + lcomp - list-completion hacks; + maplev - major mode for Maple; + map-lines - map a command over lines matching a regexp; + marker-visit - navigate through a buffer's marks in order; + matlab - major mode for MatLab dot-m files; + minibuf-electric - electric minibuffer behavior from XEmacs; + minibuffer-complete-cycle - cycle through the *Completions* buffer; + miniedit - enhanced editing for minibuffer fields; + mutt-alias - lookup and insert the expansion of mutt mail aliases; + muttrc-mode - major mode for editing Mutt config files; + obfusurl - obfuscate an URL; + pack-windows - resize all windows to display as much info as possible; + perldoc - show help for Perl functions and modules. (Depends on perl-doc); + pod-mode - major mode for editing POD files; + pp-c-l - display Control-l characters in a pretty way; + projects - create project-based meaningful buffer names; + prot-buf - protect buffers from accidental killing; + protocols - perform lookups in /etc/protocols; + quack - enhanced support for editing and running Scheme code; + rfcview - view IETF RFCs with readability-improved formatting; + services - perform lookups in /etc/services; + session - saves settings between Emacs invocations and visits to a file; + setnu - setnu-mode, a vi-style line number mode; + shell-command - enables tab-completion for shell-command; + show-wspace - highlight whitespaces of various kinds; + silly-mail - generate bozotic mail headers; + slang-mode.el - a major-mode for editing S-Lang scripts; + sys-apropos - interface for the *nix apropos command; + tabbar - Display a tab bar in the header line; + tail - "tail -f" a file or a command from within Emacs; + tc - cite text with proper filling; + thinks - quote texts in cartoon-like think bubbles; + tlc - major mode for editing Target Language Compiler scripts; + tld - explain top-level domain names; + todoo - major mode for editing TODO files; + toggle-option - easily toggle frequently toggled options; + twiddle - mode line hacks to keep you awake; + under - underline a region with ^ characters; + upstart-mode - mode for editing upstart files; + xrdb-mode - mode for editing X resource database files. + . + See /usr/share/doc/emacs-goodies-el/README.Debian.gz for a short + description of all files, or the Info node `emacs-goodies-el' for details. + +Package: devscripts-el +Architecture: all +Depends: emacs | emacsen, emacsen-common (>= 2.0.8), bash (>= 2.05a), devscripts, dpkg-dev-el, apel, ${misc:Depends} +Recommends: elserv +Description: Emacs wrappers for the commands in devscripts + This package contains: + devscripts - wrappers around the debuild, debc and debi commands; + pbuilder-log-view - wrappers around viewing pbuilder logs; + pbuilder - wrappers around pbuilder + . + See /usr/share/doc/devscripts-el/README.Debian for a short description. + +Package: debian-el +Architecture: all +Pre-Depends: xz-utils +Depends: emacs | emacsen, emacsen-common (>= 2.0.8), reportbug (>= 4.12), ${misc:Depends}, dpkg (>= 1.15.4) | install-info, bzip2, file +Recommends: wget, dlocate, groff-base +Suggests: gnus +Replaces: debbugs-el, debview +Provides: debbugs-el, debview +Section: utils +Description: Emacs helpers specific to Debian users + This package contains: + . + apt-sources - major mode for editing Debian sources.list files; + apt-utils - interface to APT (Debian package management); + debian-bug - an Emacs command to submit a bug report; + deb-view - view contents of Debian package, similarly to tar-mode; + gnus-BTS - provides buttons for bug numbers seen in Gnus messages; + preseed - major mode for editing debian-installer preseed files. + . + See /usr/share/doc/debian-el/README.Debian for a short description of + all files, or the Info node `debian-el' for details. + +Package: dpkg-dev-el +Architecture: all +Depends: emacs | emacsen, emacsen-common (>= 2.0.8), debian-el (>= 33.2), ${misc:Depends} +Suggests: dpkg-dev +Recommends: wget +Conflicts: dpkg-dev (<< 1.7.2) +Section: utils +Description: Emacs helpers specific to Debian development + This package contains: + . + debian-bts-control - builds control@bugs.debian.org email messages; + debian-changelog-mode - a helper mode for Debian changelogs; + debian-control-mode - a helper mode for debian/control files; + debian-copyright - major mode for Debian package copyright files; + readme-debian - major mode for editing README.Debian files. + . + See /usr/share/doc/dpkg-dev-el/README.Debian for a short description of + all files. diff --git a/debian/copyright b/debian/copyright new file mode 100644 index 0000000..44fc784 --- /dev/null +++ b/debian/copyright @@ -0,0 +1,2 @@ +There are specific copyright files for each individual binary package. +This file is just here to keep lintian happy. diff --git a/debian/debian-el.README.Debian b/debian/debian-el.README.Debian new file mode 100644 index 0000000..6600f3f --- /dev/null +++ b/debian/debian-el.README.Debian @@ -0,0 +1,35 @@ + The file you're currently reading is mostly meant as an introductory +starter for the various goodies included in debian-el. Consult the Info +node `debian-el' for more complete information. + +To customize all files in this package, use: + + M-x customize-group [RET] debian-el [RET] + + +Introduction to files in debian-el +---------------------------------- + +apt-sources.el provides apt-sources-mode, a major mode to help the +edition of /etc/apt/sources.list (and suchlike) files. To use it, +either open a file named sources.list and it will be autoloaded, or +add a local variables section to the end of your file to specify the +mode to be "apt-sources". + +apt-utils.el provides an interface to APT. Start things off using e.g.: +M-x apt-utils-show-package RET emacs21 RET + +debian-bug.el provides M-x debian-bug (and variants), to submit bugs +to the Debian bug tracking system. + +deb-view.el presents the contents of debian package archive files for +viewing (similar to tar-mode). + +gnus-BTS.el makes bug numbers clickable in messages viewed in Gnus. +It expects to see bug references in the form of (for example): +"#48273", "closes: 238742" or similar. To use, add the following to +your .gnus: "(require 'gnus-BTS)". + +preseed.el is a major mode for editing debian-installer preseed files. + + -- Peter S Galbraith , Mon Oct 24 21:10:25 2005 diff --git a/debian/debian-el.copyright b/debian/debian-el.copyright new file mode 100644 index 0000000..a68c893 --- /dev/null +++ b/debian/debian-el.copyright @@ -0,0 +1,66 @@ +Format: http://www.debian.org/doc/packaging-manuals/copyright-format/1.0/ +Comment: + This collection of files was assembled by Roland Mas + from various messages posted on the gnu.emacs.sources newsgroup, as well as + from various collections of Emacs Lisp files found on the web. Some + authors contacted Roland directly, some users sent me the files by email. + Most of them are covered by the GNU GPL, but the individual licences can + vary. + +Files: * +Copyright: 2000-2003 Roland Mas , + 2005-2014 Peter S Galbraith + 2014 Julian Gilbey +License: GPL-2+ +Comment: + This covers the debian/* files, and various other glue files written + specificially for this package. + +Files: elisp/debian-el/apt-sources.el +Copyright: 2001-2002, Dr. Rafael Sepúlveda +License: GPL-2+ + +Files: elisp/debian-el/apt-utils.el +Copyright: 2002, 03 Matthew P. Hodges +License: GPL-2+ + +Files: elisp/debian-el/debian-bug.el +Copyright: 1998, 1999 Free Software Foundation, Inc., + 2001, 2002 Peter S Galbraith +License: GPL-2+ +Comment: + Author (Up to version 1.7): Francesco Potortì + Maintainer from version 1.8 onwards: Peter S Galbraith + +Files: elisp/debian-el/deb-view.el +Copyright: Rick Macdonald +License: GPL-2+ + +Files: elisp/debian-el/gnus-BTS.el +Copyright: 2001 Andreas Fuchs +License: GPL-2+ + +Files: elisp/debian-el/preseed.el +Copyright: 2004 W. Borgert +License: GPL-2+ + +License: GPL-2+ + This program is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public License as + published by the Free Software Foundation; either version 2, or (at + your option) any later version. + . + This program is distributed in the hope that it will be + useful, but WITHOUT ANY WARRANTY; without even the implied + warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + PURPOSE. See the GNU General Public License for more + details. + . + You should have received a copy of the GNU General Public + License along with this package; if not, write to the Free + Software Foundation, Inc., 51 Franklin St, Fifth Floor, + Boston, MA 02110-1301 USA + . + On Debian systems, the full text of the GNU General Public + License version 2 can be found in the file + `/usr/share/common-licenses/GPL-2'. diff --git a/debian/debian-el.emacsen-compat b/debian/debian-el.emacsen-compat new file mode 100644 index 0000000..573541a --- /dev/null +++ b/debian/debian-el.emacsen-compat @@ -0,0 +1 @@ +0 diff --git a/debian/debian-el.emacsen-install.in b/debian/debian-el.emacsen-install.in new file mode 100644 index 0000000..e3f7691 --- /dev/null +++ b/debian/debian-el.emacsen-install.in @@ -0,0 +1,35 @@ +#! /bin/bash -e +# /usr/lib/emacsen-common/packages/install/debian-el + +# Written by Jim Van Zandt , borrowing heavily +# from the install scripts for gettext by Santiago Vila +# and octave by Dirk Eddelbuettel . +# +# Patched by Roland Mas to add support for lists of +# flavor-dependently included/excluded files and by Peter S Galbraith +# to add a STAMPFILE (to only byte-compile once) and +# APPEND_LOAD_PATH ton augment the load-path for byte-compilation. + +FLAVOR=$1 +PACKAGE=debian-el +STAMPFILE=debian-el.elc + +# INCLUDED_emacs20="" +# INCLUDED_emacs21="" +# INCLUDED_xemacs21="" +# INCLUDED_emacs_snapshot="" + +# EXCLUDED_emacs20="" +# EXCLUDED_emacs21="" +# EXCLUDED_xemacs21="" +# EXCLUDED_emacs_snapshot="" + +# Don't byte-compile gnus-BTS.el since it uses gnus macros and will break +# if compiled and then used with different versions of gnus (e.g. as +# shipped wth Emacs vs package separately). +SOURCEONLY_emacs20="gnus-BTS.el" +SOURCEONLY_emacs21="gnus-BTS.el" +SOURCEONLY_emacs22="gnus-BTS.el" +SOURCEONLY_emacs23="gnus-BTS.el" +SOURCEONLY_xemacs21="gnus-BTS.el" +SOURCEONLY_emacs_snapshot="gnus-BTS.el" diff --git a/debian/debian-el.emacsen-remove.in b/debian/debian-el.emacsen-remove.in new file mode 100644 index 0000000..efd7e44 --- /dev/null +++ b/debian/debian-el.emacsen-remove.in @@ -0,0 +1,5 @@ +#!/bin/sh -e +# /usr/lib/emacsen-common/packages/remove/debian-el + +FLAVOR=$1 +PACKAGE=debian-el diff --git a/debian/debian-el.emacsen-startup b/debian/debian-el.emacsen-startup new file mode 100644 index 0000000..51fa4d3 --- /dev/null +++ b/debian/debian-el.emacsen-startup @@ -0,0 +1,18 @@ +;; -*-emacs-lisp-*- +;; +;; Emacs startup file for the Debian GNU/Linux devscripts-el package + +(cond + ((not (file-exists-p "/usr/share/emacs/site-lisp/debian-el")) + (message "Package debian-el removed but not purged. Skipping setup.")) + ((not (file-exists-p (concat "/usr/share/" + (symbol-name debian-emacs-flavor) + "/site-lisp/debian-el/preseed.elc"))) + (message "Package debian-el not fully installed. Skipping setup.")) + (t + (debian-pkg-add-load-path-item + (concat "/usr/share/" + (symbol-name debian-emacs-flavor) + "/site-lisp/debian-el")) + + (require 'debian-el))) diff --git a/debian/debian-el.info b/debian/debian-el.info new file mode 100644 index 0000000..14a3d8a --- /dev/null +++ b/debian/debian-el.info @@ -0,0 +1 @@ +info/debian-el diff --git a/debian/debian-el.install b/debian/debian-el.install new file mode 100644 index 0000000..d82ee64 --- /dev/null +++ b/debian/debian-el.install @@ -0,0 +1,8 @@ +elisp/debian-el/apt-sources.el /usr/share/emacs/site-lisp/debian-el/ +elisp/debian-el/apt-utils.el /usr/share/emacs/site-lisp/debian-el/ +elisp/debian-el/deb-view.el /usr/share/emacs/site-lisp/debian-el/ +elisp/debian-el/debian-bug.el /usr/share/emacs/site-lisp/debian-el/ +elisp/debian-el/debian-el.el /usr/share/emacs/site-lisp/debian-el/ +elisp/debian-el/debian-el-loaddefs.el /usr/share/emacs/site-lisp/debian-el/ +elisp/debian-el/gnus-BTS.el /usr/share/emacs/site-lisp/debian-el/ +elisp/debian-el/preseed.el /usr/share/emacs/site-lisp/debian-el/ diff --git a/debian/debian-el.postinst b/debian/debian-el.postinst new file mode 100644 index 0000000..5ca4e57 --- /dev/null +++ b/debian/debian-el.postinst @@ -0,0 +1,21 @@ +#!/bin/sh +# Remove old /etc/50debian-el file that may still be on systems from +# previous versions of debian-el +set -e + +case "$1" in + configure) + + if [ -f /etc/emacs/site-start.d/50debian-el ]; then + rm -f /etc/emacs/site-start.d/50debian-el + fi + ;; + + abort-upgrade|abort-remove|abort-deconfigure) + ;; + *) + echo "postinst called with unknown argument \`$1'" >&2 + ;; +esac + +#DEBHELPER# diff --git a/debian/devscripts-el.README.Debian b/debian/devscripts-el.README.Debian new file mode 100644 index 0000000..bb55373 --- /dev/null +++ b/debian/devscripts-el.README.Debian @@ -0,0 +1,36 @@ + This is an introductory starter for the various goodies included +devscripts-el. It does not intend to replace reading the documentation +that is made available in the files themselves (or not available at all, +except insofar as code is self-documenting). + +Introduction to files in devscripts-el +-------------------------------------- + +devscripts.el provides + + M-x debuild + M-x debc + M-x debi + M-x debclean + M-x debdiff + +commands to call the corresponding utilities from within Emacs. + +pbuilder-mode.el provides + + M-x pdebuild + M-x pdebuild-user-mode-linux + M-x pbuilder-build + M-x pbuilder-user-mode-linux-build + M-x debuild-pbuilder + +commands to call the corresponding utilities from within Emacs. + +pbuilder-log-view-mode.el provides + + M-x pbuilder-log-view-elserv + +command to view pbuilder and debuild logs from Mozilla through elserv web +server. + + -- Peter S Galbraith , Mon Oct 24 21:09:09 2005 diff --git a/debian/devscripts-el.copyright b/debian/devscripts-el.copyright new file mode 100644 index 0000000..00262d1 --- /dev/null +++ b/debian/devscripts-el.copyright @@ -0,0 +1,44 @@ +Format: http://www.debian.org/doc/packaging-manuals/copyright-format/1.0/ +Comment: + This collection of files was assembled by Roland Mas + from various messages posted on the gnu.emacs.sources newsgroup, as well as + from various collections of Emacs Lisp files found on the web. Some + authors contacted Roland directly, some users sent me the files by email. + Most of them are covered by the GNU GPL, but the individual licences can + vary. + +Files: * +Copyright: 2000-2003 Roland Mas , + 2005-2014 Peter S Galbraith + 2014 Julian Gilbey +License: GPL-2+ +Comment: + This covers the debian/* files, and various other glue files written + specificially for this package. + +Files: elisp/devscripts-el/devscripts.el + elisp/devscripts-el/pbuilder-log-view-mode.el + elisp/devscripts-el/pbuilder-mode.el +Copyright: 2002 Junichi Uekawa +License: GPL-2+ + +License: GPL-2+ + This program is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public License as + published by the Free Software Foundation; either version 2, or (at + your option) any later version. + . + This program is distributed in the hope that it will be + useful, but WITHOUT ANY WARRANTY; without even the implied + warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + PURPOSE. See the GNU General Public License for more + details. + . + You should have received a copy of the GNU General Public + License along with this package; if not, write to the Free + Software Foundation, Inc., 51 Franklin St, Fifth Floor, + Boston, MA 02110-1301 USA + . + On Debian systems, the full text of the GNU General Public + License version 2 can be found in the file + `/usr/share/common-licenses/GPL-2'. diff --git a/debian/devscripts-el.emacsen-compat b/debian/devscripts-el.emacsen-compat new file mode 100644 index 0000000..573541a --- /dev/null +++ b/debian/devscripts-el.emacsen-compat @@ -0,0 +1 @@ +0 diff --git a/debian/devscripts-el.emacsen-install.in b/debian/devscripts-el.emacsen-install.in new file mode 100644 index 0000000..4634b64 --- /dev/null +++ b/debian/devscripts-el.emacsen-install.in @@ -0,0 +1,37 @@ +#! /bin/bash -e +# /usr/lib/emacsen-common/packages/install/devscripts-el + +# Written by Jim Van Zandt , borrowing heavily +# from the install scripts for gettext by Santiago Vila +# and octave by Dirk Eddelbuettel . +# +# Patched by Roland Mas to add support for lists +# of flavor-dependently included/excluded files + +FLAVOR=$1 +STAMPFILE=devscripts.elc +# We need elserv, flim, apel, etc. So use full Debian setup of packages +FLAGS="-q -batch -l path.el -f batch-byte-compile" +PACKAGE=devscripts-el + +# INCLUDED_emacs20="" +# INCLUDED_emacs21="" +# INCLUDED_xemacs21="" + +# EXCLUDED_emacs20="" +# EXCLUDED_emacs21="" +# EXCLUDED_xemacs21="" + +# devscripts.el requires apel to be byte-compiled before it can be +# byte-compiled itself. This could easily go wrong, as shown in +# bug#737202; there, emacs23 did the byte compiling of all installed +# packages when a new version of emacs23 was being configured, but it +# had not yet byte-compiled apel when it attempted to compile +# devscripts-el. So we skip the byte-compilation of devscripts-el if +# apel has not yet been byte-compiled; this is a workaround for the +# emacs bug which has been uncovered by this. + +if [ ! -e "/usr/share/$FLAVOR/site-lisp/apel/mcharset.elc" ] +then + exit 0 +fi diff --git a/debian/devscripts-el.emacsen-remove.in b/debian/devscripts-el.emacsen-remove.in new file mode 100644 index 0000000..8395aa4 --- /dev/null +++ b/debian/devscripts-el.emacsen-remove.in @@ -0,0 +1,5 @@ +#!/bin/sh -e +# /usr/lib/emacsen-common/packages/remove/devscripts-el + +FLAVOR=$1 +PACKAGE=devscripts-el diff --git a/debian/devscripts-el.emacsen-startup b/debian/devscripts-el.emacsen-startup new file mode 100644 index 0000000..bb0f977 --- /dev/null +++ b/debian/devscripts-el.emacsen-startup @@ -0,0 +1,35 @@ +;; -*-emacs-lisp-*- +;; +;; Emacs startup file for the Debian GNU/Linux devscripts-el package + +(cond + ((not (file-exists-p "/usr/share/emacs/site-lisp/devscripts-el")) + (message "Package devscripts-el removed but not purged. Skipping setup.")) + ((not (file-exists-p (concat "/usr/share/" + (symbol-name debian-emacs-flavor) + "/site-lisp/devscripts-el/pbuilder-mode.elc"))) + (message "Package devscripts-el not fully installed. Skipping setup.")) + (t + + (debian-pkg-add-load-path-item + (concat "/usr/share/" + (symbol-name debian-emacs-flavor) + "/site-lisp/devscripts-el")) + + ;; autoloads for devscripts.el + (autoload 'debuild "devscripts" "Run debuild in the current directory." t) + (autoload 'debc "devscripts" "Run debc in the current directory." t) + (autoload 'debi "devscripts" "Run debi in the current directory." t) + (autoload 'debit "devscripts" "Run debit in the current directory." t) + (autoload 'debdiff "devscripts" "Compare contents of CHANGES-FILE-1 and CHANGES-FILE-2." t) + (autoload 'debdiff-current "devscripts" "Compare the contents of .changes file of current version with previous version; +requires access to debian/changelog, and being in debian/ dir." t) + (autoload 'debclean "devscripts" "Run debclean in the current directory." t) + (autoload 'pdebuild "pbuilder-mode" "Run pdebuild in the current directory." t) + (autoload 'pdebuild-user-mode-linux "pbuilder-mode" "Run pdebuild-user-mode-linux in the current directory." t) + (autoload 'pbuilder-log-view-elserv "pbuilder-log-view-mode" "Run a elserv session with log view. + +Running this requires elserv. Use elserv, and do `elserv-start' before invoking this command." t) + (autoload 'debuild-pbuilder "pbuilder-mode" "Run debuild-pbuilder in the current directory." t) + (autoload 'pbuilder-build "pbuilder-mode" "Run pbuilder-build for the given filename." t) + (autoload 'pbuilder-user-mode-linux-build "pbuilder-mode" "Run pbuilder-user-mode-linux for the given filename." t))) diff --git a/debian/devscripts-el.install b/debian/devscripts-el.install new file mode 100644 index 0000000..f8307b1 --- /dev/null +++ b/debian/devscripts-el.install @@ -0,0 +1,3 @@ +elisp/devscripts-el/devscripts.el /usr/share/emacs/site-lisp/devscripts-el/ +elisp/devscripts-el/pbuilder-log-view-mode.el /usr/share/emacs/site-lisp/devscripts-el/ +elisp/devscripts-el/pbuilder-mode.el /usr/share/emacs/site-lisp/devscripts-el/ diff --git a/debian/dpkg-dev-el.README.Debian b/debian/dpkg-dev-el.README.Debian new file mode 100644 index 0000000..1620bc6 --- /dev/null +++ b/debian/dpkg-dev-el.README.Debian @@ -0,0 +1,35 @@ + This file is an introductory starter for the various goodies included in +dpkg-dev-el. It does not intend to replace reading the documentation that +is made available in the files themselves (or not available at all, except +insofar as code is self-documenting). + +To customize all files in this package, use: + + M-x customize-group [RET] dpkg-dev-el [RET] + +Introduction to files in dpkg-dev-el +------------------------------------ + +debian-bts-control.el provides an interface for composing email messages to +the Debian BTS control interface (control@bugs.debian.org). Tab completions +works for all possible commands and their options. + +debian-changelog-mode.el provides a mode for editing debian/changelog +files. This mode adds colouring, a few commands to manipulate +changelog entries and bug reports, and a nice filling function. This +mode can also be used to add colours to buffers visiting the +changelogs in /usr/share/doc//changelog.Debian files. + +debian-copyright.el provides a mode for editing debian/copyright files. +This mode adds a bit of colouring and if `goto-addr' is loaded, it will +make the URLs clickable. + +debian-control-mode.el provides a mode for editing debian/control +files. This mode adds a bit of colouring, a working filling function +(bound to "M-q" by default), tab-completion for adding fields (bound +to "C-c C-a" by default), and viewing bugs (bound to "C-c C-b"). + +readme-debian.el provides readme-debian-mode, a major mode to +highlight README.Debian files. + + -- Peter S Galbraith , Mon Oct 24 21:08:04 2005 diff --git a/debian/dpkg-dev-el.copyright b/debian/dpkg-dev-el.copyright new file mode 100644 index 0000000..a01ede2 --- /dev/null +++ b/debian/dpkg-dev-el.copyright @@ -0,0 +1,60 @@ +Format: http://www.debian.org/doc/packaging-manuals/copyright-format/1.0/ +Comment: + This collection of files was assembled by Roland Mas + from various messages posted on the gnu.emacs.sources newsgroup, as well as + from various collections of Emacs Lisp files found on the web. Some + authors contacted Roland directly, some users sent me the files by email. + Most of them are covered by the GNU GPL, but the individual licences can + vary. + +Files: * +Copyright: 2000-2003 Roland Mas , + 2005-2014 Peter S Galbraith + 2014 Julian Gilbey +License: GPL-2+ +Comment: + This covers the debian/* files, and various other glue files written + specificially for this package. + +Files: elisp/dpkg-dev-el/debian-bts-control.el +Copyright: 2003 Peter S Galbraith +License: GPL-2+ + +Files: elisp/dpkg-dev-el/debian-changelog-mode.el +Copyright: 1996 Ian Jackson, 1997 Klee Dienes, 1999 Chris Waters, + 2000 Peter S Galbraith +License: GPL-2+ + +Files: elisp/dpkg-dev-el/debian-control-mode.el +Copyright: 2001 Free Software Foundation, Inc. +License: GPL-2+ +Comment: Author: Colin Walters + +Files: elisp/dpkg-dev-el/debian-copyright.el +Copyright: 2002, 2003 Junichi Uekawa +License: GPL-2+ + +Files: elisp/dpkg-dev-el/readme-debian.el +Copyright: 2002 Junichi Uekawa +License: GPL-2+ + +License: GPL-2+ + This program is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public License as + published by the Free Software Foundation; either version 2, or (at + your option) any later version. + . + This program is distributed in the hope that it will be + useful, but WITHOUT ANY WARRANTY; without even the implied + warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + PURPOSE. See the GNU General Public License for more + details. + . + You should have received a copy of the GNU General Public + License along with this package; if not, write to the Free + Software Foundation, Inc., 51 Franklin St, Fifth Floor, + Boston, MA 02110-1301 USA + . + On Debian systems, the full text of the GNU General Public + License version 2 can be found in the file + `/usr/share/common-licenses/GPL-2'. diff --git a/debian/dpkg-dev-el.emacsen-compat b/debian/dpkg-dev-el.emacsen-compat new file mode 100644 index 0000000..573541a --- /dev/null +++ b/debian/dpkg-dev-el.emacsen-compat @@ -0,0 +1 @@ +0 diff --git a/debian/dpkg-dev-el.emacsen-install.in b/debian/dpkg-dev-el.emacsen-install.in new file mode 100644 index 0000000..94f087c --- /dev/null +++ b/debian/dpkg-dev-el.emacsen-install.in @@ -0,0 +1,23 @@ +#! /bin/bash -e +# /usr/lib/emacsen-common/packages/install/dpkg-dev-el + +# Written by Jim Van Zandt , borrowing heavily +# from the install scripts for gettext by Santiago Vila +# and octave by Dirk Eddelbuettel . +# +# Patched by Roland Mas to add support for lists +# of flavor-dependently included/excluded files + +FLAVOR=$1 +STAMPFILE=debian-changelog-mode.elc +PACKAGE=dpkg-dev-el + +APPEND_LOAD_PATH="'(\"/usr/share/emacs/site-lisp/debian-el/\")" + +# INCLUDED_emacs20="" +# INCLUDED_emacs21="" +# INCLUDED_xemacs21="" + +# EXCLUDED_emacs20="" +# EXCLUDED_emacs21="" +# EXCLUDED_xemacs21="" diff --git a/debian/dpkg-dev-el.emacsen-remove.in b/debian/dpkg-dev-el.emacsen-remove.in new file mode 100644 index 0000000..000fa24 --- /dev/null +++ b/debian/dpkg-dev-el.emacsen-remove.in @@ -0,0 +1,5 @@ +#!/bin/sh -e +# /usr/lib/emacsen-common/packages/remove/dpkg-dev-el + +FLAVOR=$1 +PACKAGE=dpkg-dev-el diff --git a/debian/dpkg-dev-el.emacsen-startup b/debian/dpkg-dev-el.emacsen-startup new file mode 100644 index 0000000..4483b8e --- /dev/null +++ b/debian/dpkg-dev-el.emacsen-startup @@ -0,0 +1,18 @@ +;; -*-emacs-lisp-*- +;; +;; Emacs startup file for the Debian GNU/Linux dpkg-dev-el package + +(cond + ((not (file-exists-p "/usr/share/emacs/site-lisp/dpkg-dev-el")) + (message "Package dpkg-dev-el removed but not purged. Skipping setup.")) + ((not (file-exists-p (concat "/usr/share/" + (symbol-name debian-emacs-flavor) + "/site-lisp/dpkg-dev-el/readme-debian.elc"))) + (message "Package dpkg-dev-el not fully installed. Skipping setup.")) + (t + (debian-pkg-add-load-path-item + (concat "/usr/share/" + (symbol-name debian-emacs-flavor) + "/site-lisp/dpkg-dev-el")) + + (require 'dpkg-dev-el))) diff --git a/debian/dpkg-dev-el.install b/debian/dpkg-dev-el.install new file mode 100644 index 0000000..e49cf6c --- /dev/null +++ b/debian/dpkg-dev-el.install @@ -0,0 +1,7 @@ +elisp/dpkg-dev-el/debian-bts-control.el /usr/share/emacs/site-lisp/dpkg-dev-el/ +elisp/dpkg-dev-el/debian-changelog-mode.el /usr/share/emacs/site-lisp/dpkg-dev-el/ +elisp/dpkg-dev-el/debian-control-mode.el /usr/share/emacs/site-lisp/dpkg-dev-el/ +elisp/dpkg-dev-el/debian-copyright.el /usr/share/emacs/site-lisp/dpkg-dev-el/ +elisp/dpkg-dev-el/dpkg-dev-el-loaddefs.el /usr/share/emacs/site-lisp/dpkg-dev-el/ +elisp/dpkg-dev-el/dpkg-dev-el.el /usr/share/emacs/site-lisp/dpkg-dev-el/ +elisp/dpkg-dev-el/readme-debian.el /usr/share/emacs/site-lisp/dpkg-dev-el/ diff --git a/debian/emacs-goodies-el.copyright b/debian/emacs-goodies-el.copyright new file mode 100644 index 0000000..701dd46 --- /dev/null +++ b/debian/emacs-goodies-el.copyright @@ -0,0 +1,527 @@ +Format: http://www.debian.org/doc/packaging-manuals/copyright-format/1.0/ +Comment: + This collection of files was assembled by Roland Mas + from various messages posted on the gnu.emacs.sources newsgroup, as well as + from various collections of Emacs Lisp files found on the web. Some + authors contacted Roland directly, some users sent me the files by email. + Most of them are covered by the GNU GPL, but the individual licences can + vary. + +Files: * +Copyright: 2000-2003 Roland Mas , + 2005-2014 Peter S Galbraith + 2014 Julian Gilbey +License: GPL-2+ +Comment: + This covers the debian/* files, and various other glue files written + specificially for this package. + +Files: elisp/emacs-goodies-el/align-string.el +Copyright: 2001 Markus Bjartveit Krüger +License: GPL-2+ +Comment: http://www.pvv.org/~markusk/align-string.el + +Files: elisp/emacs-goodies-el/all.el +Copyright: 1985, 1986, 1987, 1992, 1994 Free Software Foundation, Inc., + 1994 Per Abrahamsen +License: GPL-2+ + +Files: elisp/emacs-goodies-el/apache-mode.el +Copyright: Jonathan Marten , + Karl Chen +License: GPL-2+ +Comment: http://www.emacswiki.org/elisp/apache-mode.el + +Files: elisp/emacs-goodies-el/ascii.el +Copyright: 1999, 2000, 2001 Vinicius Jose Latorre +License: GPL-2+ + +Files: elisp/emacs-goodies-el/auto-fill-inhibit.el +Copyright: 2001 Michael Weber +License: GPL-2-no-virus + This program is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public License + version 2 as published by the Free Software Foundation. + . + 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 package; if not, write to the Free + Software Foundation, Inc., 51 Franklin St, Fifth Floor, + Boston, MA 02110-1301 USA + . + On Debian systems, the full text of the GNU General Public + License version 2 can be found in the file + `/usr/share/common-licenses/GPL-2'. + . + NO-VIRUS CLAUSE: + The intent of this license is to protect free redistribution and + reuse of the source of the licensed distribution, not to prejudice + the authorship rights of programmers of other code to control + their original inventions. + . + No portion of this license is to be interpreted as forbidding the + reuse of this code or its constituent parts, algorithms, or + inventions in commercial products. + . + Nor shall such inclusion be construed to require the GPLing or + disclosure of any portions of said commercial products other than + those falling under the copyright of the licensed distribution. + +Files: elisp/emacs-goodies-el/bar-cursor.el +Copyright: 2001 by Joseph L. Casadonte Jr. +License: GPL-2+ + +Files: elisp/emacs-goodies-el/bm.el +Copyright: 2000-2010 Jo Odland , + Portions Copyright 2002 by Ben Key, + Updated by Ben Key on 2002-12-05 + to add support for XEmacs +License: GPL-2+ + +Files: elisp/emacs-goodies-el/boxquote.el +Copyright: 1999-2009 by Dave Pearson +License: GPL-2+ + +Files: elisp/emacs-goodies-el/browse-huge-tar.el +Copyright: Gareth Owen 1999 +License: GPL-2+ + +Files: elisp/emacs-goodies-el/browse-kill-ring.el +Copyright: 2001 Colin Walters +License: GPL-2+ + +Files: elisp/emacs-goodies-el/button-lock.el +Copyright: 2011 D Roland Walker +License: GPL-2+ + +Files: elisp/emacs-goodies-el/clipper.el +Copyright: 1997-2000 Free Software Foundation, Inc. +License: GPL-2+ +Comment: + Author: Kevin A. Burton (burton@openprivacy.org) + Maintainer: Kevin A. Burton (burton@openprivacy.org) + Location: http://relativity.yi.org + +Files: elisp/emacs-goodies-el/coffee.el +Copyright: 1999, 2003 Eric Marsden +License: GPL-2+ + +Files: elisp/emacs-goodies-el/color-theme.el +Copyright: 1999, 2000 Jonadab the Unsightly One , + 2000, 2001, 2002, 2003 Alex Schroeder , + 2003, 2004 Xavier Maillard +License: GPL-2+ +Comment: + Author: Jonadab the Unsightly One + Maintainer: Xavier Maillard + URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ColorTheme + +Files: elisp/emacs-goodies-el/color-theme-library.el +Copyright: 2005, 2006 Xavier Maillard , + 2005, 2006 Brian Palmer +License: GPL-2+ +Comment: + Author: Brian Palmer, Xavier Maillard + Maintainer: Xavier Maillard + URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ColorTheme + +Files: elisp/emacs-goodies-el/color-theme_selfdefcustom.el +Copyright: 2005 Peter S Galbraith +License: GPL-2+ + +Files: elisp/emacs-goodies-el/csv-mode.el +Copyright: 2003, 2004 Francis J. Wright +License: GPL-2+ +Comment: + http://centaur.maths.qmul.ac.uk/Emacs/ + +Files: elisp/emacs-goodies-el/ctypes.el +Copyright: 1997, 1999 Anders Lindgren +License: GPL-2+ + +Files: elisp/emacs-goodies-el/dedicated.el +Copyright: 2000 Eric Crampton +License: GPL-2+ + +Files: elisp/emacs-goodies-el/df.el +Copyright: 1999 by Association April +License: GPL-2+ +Comment: Author: Benjamin Drieu + +Files: elisp/emacs-goodies-el/diminish.el +Copyright: 1998 Free Software Foundation, Inc. +License: GPL-2+ +Comment: + Author: Will Mengarini + URL: + +Files: elisp/emacs-goodies-el/dir-locals.el +Copyright: 2005, 2006 Free Software Foundation, Inc. +License: GPL-2+ +Comment: + Author: Dave Love + URL: http://www.loveshack.ukfsn.org/emacs + +Files: elisp/emacs-goodies-el/edit-env.el +Copyright: 2001 Benjamin Rutt +License: GPL-2+ + +Files: elisp/emacs-goodies-el/egocentric.el +Copyright: 2001 Benjamin Drieu +License: GPL-2+ + +Files: elisp/emacs-goodies-el/eproject.el +Copyright: 2008, 2009 Jonathan Rockway +License: GPL-2+ + +Files: elisp/emacs-goodies-el/eproject-extras.el +Copyright: 2009 Jonathan Rockway +License: GPL-3+ + +Files: elisp/emacs-goodies-el/ff-paths.el +Copyright: 1994-2001 Peter S. Galbraith , + +License: GPL-2+ + +Files: elisp/emacs-goodies-el/filladapt.el +Copyright: 1989, 1995-1998 Kyle E. Jones +License: GPL-2+ + +Files: elisp/emacs-goodies-el/floatbg.el +Copyright: 2001 John Paul Wallington +License: GPL-2+ + +Files: elisp/emacs-goodies-el/folding.el +Copyright: 1994-2004 Jari Aalto, Anders Lindgren, All rights reserved. + 1992, 1993 Jamie Lokier, All rights reserved. +License: GPL-2+ +Comment: + http://cvs.sourceforge.net/viewcvs.py/tiny-tools/tiny-tools/lisp/other/ + +Files: elisp/emacs-goodies-el/framepop.el +Copyright: 1993, 1995 Free Software Foundation, Inc. + 2003 Peter S Galbraith +License: GPL-2+ +Comment: + Author: David Smith + Maintainer: Peter S Galbraith + +Files: elisp/emacs-goodies-el/graphviz-dot-mode.el +Copyright: 2002 - 2005 Pieter Pareit +License: GPL-2+ +Comment: + Authors: Pieter Pareit + Rubens Ramos + Maintainer: Pieter Pareit + +Files: elisp/emacs-goodies-el/highlight-beyond-fill-column.el +Copyright: 1985, 1986, 1987, 1992 Free Software Foundation, Inc. +License: GPL-2+ +Comment: + Author: Sandip Chitale (sandip.chitale@blazesoft.com) + +Files: elisp/emacs-goodies-el/highlight-completion.el +Copyright: 1991-1996 Mark Haiman, Nick Reingold, John Palmieri, + 1997-2001 John Palmieri +License: GPL-2+ +Comment: + Author: John Palmieri + +Files: elisp/emacs-goodies-el/highlight-current-line.el +Copyright: 1997 Christoph Conrad +License: GPL-2+ + +Files: elisp/emacs-goodies-el/home-end.el +Copyright: 1996 Kai Grossjohann and Toby Speight, 2002 Toby Speight +License: GPL-3 + +Files: elisp/emacs-goodies-el/htmlize.el +Copyright: 1997,1998,1999,2000 Hrvoje Niksic +License: GPL-2+ + +Files: elisp/emacs-goodies-el/initsplit.el +Copyright: 2000, 2001 John Wiegley +License: GPL-2+ + +Files: elisp/emacs-goodies-el/joc-toggle-buffer.el +Copyright: 2001 by Joseph L. Casadonte Jr. +License: GPL-2+ +Comment: Renamed from toggle-buffer.el + +Files: elisp/emacs-goodies-el/joc-toggle-case.el +Copyright: 2001 by Joseph L. Casadonte Jr. +License: GPL-2+ +Comment: Renamed from toggle-case.el + +Files: elisp/emacs-goodies-el/keydef.el +Copyright: 2001 Michael John Downes +License: public-domain + This program was placed in the public domain on 2001/01/18 by the + Author. The 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. + +Files: elisp/emacs-goodies-el/keywiz.el +Copyright: 2002 Jesper Harder +License: GPL-2+ + +Files: elisp/emacs-goodies-el/lcomp.el +Copyright: 2002 Taiki SUGAWARA +License: GPL-2+ + +Files: elisp/emacs-goodies-el/maplev.* +Copyright: 2001,2003 Joseph S. Riel +License: GPL-2+ +Comment: + Authors: Joseph S. Riel + and Roland Winkler + URL: https://github.com/JoeRiel/maplev + +Files: elisp/emacs-goodies-el/map-lines.el +Copyright: 2002 Andreas Fuchs +License: GPL-2+ + +Files: elisp/emacs-goodies-el/marker-visit.el +Copyright: 2001 Benjamin Rutt +License: GPL-2+ + +Files: elisp/emacs-goodies-el/matlab.el +Copyright: 1997-1999 Eric M. Ludlam, 1991-1997 Matthew R. Wette +License: GPL-2+ + +Files: elisp/emacs-goodies-el/minibuf-electric.el +Copyright: 1992, 1993, 1994, 1997 Free Software Foundation, Inc. + 1995 Tinker Systems. + 1995, 1996, 2000 Ben Wing. + Modified by Karl Hegbloom for GNU Emacs. +License: GPL-2+ + +Files: elisp/emacs-goodies-el/minibuffer-complete-cycle.el +Copyright: 1997,1998,2000,2003 Kevin Rodgers +License: GPL-2+ + +Files: elisp/emacs-goodies-el/miniedit.el +Copyright: 2001, 2002 Free Software Foundation, Inc. +License: GPL-2+ +Comment: + Author(s): Deepak Goel , + Christoph Conrad + +Files: elisp/emacs-goodies-el/mutt-alias.el +Copyright: 1999,2000 by Dave Pearson +License: GPL-2 + +Files: elisp/emacs-goodies-el/muttrc-mode.el +Copyright: 2000, 2001, 2002 Laurent Pelecq +License: GPL-2+ + +Files: elisp/emacs-goodies-el/obfusurl.el +Copyright: 2001-2008 by Dave Pearson +License: GPL-2+ + +Files: elisp/emacs-goodies-el/pack-windows.el +Copyright: 2000 Michel Schinz +License: GPL-2+ + +Files: elisp/emacs-goodies-el/perldoc.el +Copyright: 2000-2002 Steve Kemp , + 2003, 2005 Peter S Galbraith , + 2008-2009 Ben Voui +License: GPL-2+ + +Files: elisp/emacs-goodies-el/pod-mode.el +Copyright: 2003-2005 Steffen Schwigon +License: GPL-2+ +Comment: http://search.cpan.org/~schwigon/pod-mode/ + +Files: elisp/emacs-goodies-el/pp-c-l.el +Copyright: 2007-2010, Drew Adams, all rights reserved. +License: GPL-2+ +Comment: http://www.emacswiki.org/cgi-bin/wiki/pp-c-l.el + +Files: elisp/emacs-goodies-el/projects.el +Copyright: 1998 Naggum Software +License: GPL-2+ +Comment: + Author: Erik Naggum + +Files: elisp/emacs-goodies-el/protbuf.el +Copyright: 1994, 1999 Noah S. Friedman +License: GPL-2+ + +Files: elisp/emacs-goodies-el/protocols.el +Copyright: 2000-2008 Dave Pearson +License: GPL-2+ + +Files: elisp/emacs-goodies-el/quack.el +Copyright: 2002-2009 Neil Van Dyke +License: GPL-2+ + +Files: elisp/emacs-goodies-el/rfcview.el +Copyright: 2001-2002 Neil W. Van Dyke +License: GPL-2+ + +Files: elisp/emacs-goodies-el/services.el +Copyright: 2000-2008 Dave Pearson +License: GPL-2+ + +Files: elisp/emacs-goodies-el/session.el +Copyright: 1996-1999, 2001-2003 Free Software Foundation, Inc. +License: GPL-2+ +Comment: + Author: Christoph Wedler + X-URL: http://emacs-session.sourceforge.net/ + +Files: elisp/emacs-goodies-el/setnu.el +Copyright: 1994, 1995, 1997 Kyle E. Jones +License: GPL-2+ + +Files: elisp/emacs-goodies-el/shell-command.el +Copyright: 1998-2003 TSUCHIYA Masatoshi +License: GPL-2+ + +Files: elisp/emacs-goodies-el/show-wspace.el +Copyright: 2000-2007, Drew Adams, all rights reserved. +License: GPL-2+ +Comment: + Author: Peter Steiner , Drew Adams + Maintainer: Drew Adams + +Files: elisp/emacs-goodies-el/silly-mail.el +Copyright: 1993, 94, 95, 96, 97, 98, 99, 2000 Noah S. Friedman +License: GPL-2+ +Comment: + Contributors: Noah Friedman, Jamie Zawinski, Jim Blandy, + Thomas Bushnell, Roland McGrath, + and a cast of dozens. + Maintainer: Noah Friedman + +Files: elisp/emacs-goodies-el/slang-mode.el +Copyright: 1993, 1994, 1995 Free Software Foundation, Inc. +License: GPL-2+ +Comment: + Modified By: Joe Robertson + Modified From: tcl-mode.el + Original Author: Gregor Schmid + http://home.mchsi.com/~jmrobert5/files/slang-mode.el + +Files: elisp/emacs-goodies-el/sys-apropos.el +Copyright: 2002 Henrik Enberg +License: GPL-2+ + +Files: elisp/emacs-goodies-el/tabbar.el +Copyright: 2003 David Ponce +License: GPL-2+ + +Files: elisp/emacs-goodies-el/tail.el +Copyright: 2000 Benjamin Drieu +License: GPL-2+ + +Files: elisp/emacs-goodies-el/tc.el +Copyright: 1998 Lars R. Clausen +License: GPL-2+ + +Files: elisp/emacs-goodies-el/thinks.el +Copyright: 2000-2008 Dave Pearson +License: GPL-2+ + +Files: elisp/emacs-goodies-el/tlc.el +Copyright: 1997, 1998 by The MathWorks, Inc. +License: GPL-2+ + +Files: elisp/emacs-goodies-el/tld.el +Copyright: 2000-2008 Dave Pearson +License: GPL-2+ + +Files: elisp/emacs-goodies-el/todoo.el +Copyright: 1999 Daniel Lundin +License: GPL-2+ + +Files: elisp/emacs-goodies-el/toggle-option.el +Copyright: 2001 Cyprian Laskowski +License: GPL-2+ + +Files: elisp/emacs-goodies-el/twiddle.el +Copyright: 1997 Noah S. Friedman +License: GPL-2+ + +Files: elisp/emacs-goodies-el/under.el +Copyright: 1998 Benjamin Drieu +License: GPL-2+ + +Files: elisp/emacs-goodies-el/upstart-mode.el +Copyright: 2010 Stig Sandbeck Mathisen +License: GPL-2+ + +Files: elisp/emacs-goodies-el/xrdb-mode.el +Copyright: 1998,1999,2000 Free Software Foundation, Inc. +License: GPL-2+ +Comment: + Author: 1994-2002 Barry A. Warsaw + Maintainer: barry@python.org + +License: GPL-2 + This program is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public License + version 2 as published by the Free Software Foundation. + . + 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 package; if not, write to the Free + Software Foundation, Inc., 51 Franklin St, Fifth Floor, + Boston, MA 02110-1301 USA + . + On Debian systems, the full text of the GNU General Public + License version 2 can be found in the file + `/usr/share/common-licenses/GPL-2'. + +License: GPL-2+ + This program is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public License as + published by the Free Software Foundation; either version 2, or (at + your option) any later version. + . + This program is distributed in the hope that it will be + useful, but WITHOUT ANY WARRANTY; without even the implied + warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + PURPOSE. See the GNU General Public License for more + details. + . + You should have received a copy of the GNU General Public + License along with this package; if not, write to the Free + Software Foundation, Inc., 51 Franklin St, Fifth Floor, + Boston, MA 02110-1301 USA + . + On Debian systems, the full text of the GNU General Public + License version 2 can be found in the file + `/usr/share/common-licenses/GPL-2'. + +License: GPL-3 + This program is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public License + version 3 as published by the Free Software Foundation. + . + 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 package; if not, write to the Free + Software Foundation, Inc., 51 Franklin St, Fifth Floor, + Boston, MA 02110-1301 USA + . + On Debian systems, the full text of the GNU General Public + License version 3 can be found in the file + `/usr/share/common-licenses/GPL-3'. diff --git a/debian/emacs-goodies-el.emacsen-compat b/debian/emacs-goodies-el.emacsen-compat new file mode 100644 index 0000000..573541a --- /dev/null +++ b/debian/emacs-goodies-el.emacsen-compat @@ -0,0 +1 @@ +0 diff --git a/debian/emacs-goodies-el.emacsen-install.in b/debian/emacs-goodies-el.emacsen-install.in new file mode 100644 index 0000000..5d0820b --- /dev/null +++ b/debian/emacs-goodies-el.emacsen-install.in @@ -0,0 +1,27 @@ +#! /bin/bash -e +# /usr/lib/emacsen-common/packages/install/emacs-goodies-el + +# Written by Jim Van Zandt , borrowing heavily +# from the install scripts for gettext by Santiago Vila +# and octave by Dirk Eddelbuettel . +# +# Patched by Roland Mas to add support for lists +# of flavor-dependently included/excluded files + +FLAVOR=$1 +STAMPFILE=emacs-goodies-el.elc +PACKAGE=emacs-goodies-el + +# INCLUDED_emacs20="" +# INCLUDED_emacs21="" +# INCLUDED_xemacs21="" + +EXCLUDED_emacs20="tabbar.el session.el csv-mode.el maplev.el pod-mode.el button-lock.el" +EXCLUDED_emacs21="pod-mode.el" +EXCLUDED_xemacs21="csv-mode.el minibuf-electric.el pp-c-l.el tabbar.el todoo.el rfcview.el upstart-mode.el maplev.el button-lock.el" +#EXCLUDED_emacs_snapshot="cua.el cfengine.el ibuffer.el ido.el newsticker.el table.el " +#EXCLUDED_emacs22="cua.el cfengine.el ibuffer.el ido.el newsticker.el table.el " +EXCLUDED_emacs23="minibuffer-complete-cycle.el" + +# Skip byte-compilation here if necessary: +#SOURCEONLY_all="emacs-goodies-el.el emacs-goodies-loaddefs.el" diff --git a/debian/emacs-goodies-el.emacsen-remove.in b/debian/emacs-goodies-el.emacsen-remove.in new file mode 100644 index 0000000..eca4eab --- /dev/null +++ b/debian/emacs-goodies-el.emacsen-remove.in @@ -0,0 +1,5 @@ +#!/bin/sh -e +# /usr/lib/emacsen-common/packages/remove/emacs-goodies-el + +FLAVOR=$1 +PACKAGE=emacs-goodies-el diff --git a/debian/emacs-goodies-el.emacsen-startup b/debian/emacs-goodies-el.emacsen-startup new file mode 100644 index 0000000..d1fa5c9 --- /dev/null +++ b/debian/emacs-goodies-el.emacsen-startup @@ -0,0 +1,19 @@ +;; -*-emacs-lisp-*- +;; +;; Emacs startup file for the Debian GNU/Linux emacs-goodies-el package + +(cond + ((not (file-exists-p "/usr/share/emacs/site-lisp/emacs-goodies-el")) + (message + "Package emacs-goodies-el removed but not purged. Skipping setup.")) + ((not (file-exists-p (concat "/usr/share/" + (symbol-name debian-emacs-flavor) + "/site-lisp/emacs-goodies-el/xrdb-mode.elc"))) + (message "Package emacs-goodies-el not fully installed. Skipping setup.")) + (t + (debian-pkg-add-load-path-item + (concat "/usr/share/" + (symbol-name debian-emacs-flavor) + "/site-lisp/emacs-goodies-el")) + + (require 'emacs-goodies-el))) diff --git a/debian/emacs-goodies-el.info b/debian/emacs-goodies-el.info new file mode 100644 index 0000000..c556f5c --- /dev/null +++ b/debian/emacs-goodies-el.info @@ -0,0 +1,2 @@ +info/emacs-goodies-el* +info/maplev diff --git a/debian/emacs-goodies-el.install b/debian/emacs-goodies-el.install new file mode 100644 index 0000000..e0d82d9 --- /dev/null +++ b/debian/emacs-goodies-el.install @@ -0,0 +1,84 @@ +elisp/emacs-goodies-el/align-string.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/all.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/apache-mode.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/ascii.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/auto-fill-inhibit.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/bar-cursor.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/bm.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/boxquote.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/browse-huge-tar.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/browse-kill-ring.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/button-lock.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/coffee.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/color-theme.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/color-theme-library.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/color-theme_seldefcustom.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/clipper.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/csv-mode.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/ctypes.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/dedicated.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/df.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/diminish.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/dir-locals.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/edit-env.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/eproject.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/eproject-extras.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/egocentric.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/emacs-goodies-custom.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/emacs-goodies-el.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/ff-paths.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/filladapt.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/floatbg.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/folding.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/framepop.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/graphviz-dot-mode.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/highlight-beyond-fill-column.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/highlight-completion.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/highlight-current-line.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/home-end.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/htmlize.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/initsplit.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/joc-toggle-buffer.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/joc-toggle-case.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/keydef.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/keywiz.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/lcomp.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/maplev.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/map-lines.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/marker-visit.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/matlab.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/minibuf-electric.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/minibuffer-complete-cycle.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/miniedit.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/mutt-alias.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/muttrc-mode.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/obfusurl.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/pack-windows.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/perldoc.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/pp-c-l.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/pod-mode.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/projects.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/protbuf.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/protocols.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/quack.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/rfcview.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/services.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/session.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/setnu.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/shell-command.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/show-wspace.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/silly-mail.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/slang-mode.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/sys-apropos.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/tabbar.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/tail.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/tc.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/thinks.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/tlc.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/tld.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/todoo.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/toggle-option.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/twiddle.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/under.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/upstart-mode.el /usr/share/emacs/site-lisp/emacs-goodies-el/ +elisp/emacs-goodies-el/xrdb-mode.el /usr/share/emacs/site-lisp/emacs-goodies-el/ diff --git a/debian/emacsen-install.template b/debian/emacsen-install.template new file mode 100644 index 0000000..4300555 --- /dev/null +++ b/debian/emacsen-install.template @@ -0,0 +1,103 @@ +eval included_here=\$$(echo INCLUDED_$FLAVOR | tr - _) +eval excluded_here=\$$(echo EXCLUDED_$FLAVOR | tr - _) +eval sourceonly_here=\$$(echo SOURCEONLY_$FLAVOR | tr - _) + +included_all=$(for i in ${!INCLUDED_*} ; do + eval echo \$$i + done | sort -u) + +excluded_all=$(for i in ${!EXCLUDED_*} ; do + eval echo \$$i + done | sort -u) + +sourceonly_all=$(for i in ${!SOURCEONLY_*} ; do + eval echo \$$i + done | sort -u) + +if [ ${FLAVOR} = emacs ]; then exit 0; fi + +LOG=`tempfile -pelc_ -s.log -m644` +ELDIR=/usr/share/emacs/site-lisp/${PACKAGE} +ELCDIR=/usr/share/${FLAVOR}/site-lisp/${PACKAGE} +if test -e "${ELCDIR}/${STAMPFILE}"; then + echo "${PACKAGE} files already compiled in ${ELCDIR}." + rm -f ${LOG} + exit +fi +echo install/${PACKAGE}: Handling ${FLAVOR}, logged in ${LOG} + +if [ -z "$FLAGS" ] ; then +# FLAGS="-q -no-site-file --no-site-file -batch -l path.el -f batch-byte-compile + FLAGS="-batch -l path.el -f batch-byte-compile" +fi + +install -m 755 -d ${ELCDIR} +cd ${ELDIR} + +# Now to compute the list of files to install... + +FILES=$(ls -1 *.el) +# Here we have all of them + +PATTERN="" +for i in $included_all $excluded_all $sourceonly_all; do + [ ! -z "$PATTERN" ] && PATTERN="${PATTERN}\|" + PATTERN="${PATTERN}^$i\$" +done +FILES2=$FILES +if [ ! -z "$PATTERN" ] ; then + FILES=$(for i in $FILES2 ; do echo $i | grep -v $PATTERN || true ; done) +fi +# Here we only have those not explicitly included or excluded by any flavour + +FILES="$FILES $included_here" +# Here we also have those included for the current flavour + +for i in $excluded_all ; do + include_i="yes" + for j in $excluded_here ; do + [ $i = $j ] && include_i="no" + done + [ $include_i = "yes" ] && FILES="$FILES $i" +done +# And now we have those excluded by other flavours but not the current one + +FILES=$(for i in $FILES ; do echo $i ; done | sort -u) +# And now for my last trick... The list is now uniquified! + +# Symlinks instead of copying... +cd ${ELCDIR} +for i in $FILES $sourceonly_all; do + ln -fs /usr/share/emacs/site-lisp/${PACKAGE}/$i +done + +# Prepare the flavour specific autoload file +if [ ${PACKAGE} = emacs-goodies-el ]; then + echo Building autoloads for ${FLAVOR} in ${ELCDIR} + if [ $FLAVOR != xemacs21 ]; then + echo ";;; emacs-goodies-loaddefs.el" > emacs-goodies-loaddefs.el + echo ";; autoloads generated upon installation of the emacs-goodies-el package" >> emacs-goodies-loaddefs.el + fi + echo ${FLAVOR} -batch --no-site-file --multibyte --eval '(setq load-path (cons "." load-path))' -l autoload --eval '(setq generated-autoload-file (expand-file-name "emacs-goodies-loaddefs.el"))' --eval '(setq make-backup-files nil)' -f batch-update-autoloads . >> ${LOG} + cd ${ELCDIR} + "${FLAVOR}" -batch --no-site-file --multibyte --eval '(setq load-path (cons "." load-path))' -l autoload --eval '(setq generated-autoload-file (expand-file-name "emacs-goodies-loaddefs.el"))' --eval '(setq make-backup-files nil)' -f batch-update-autoloads . >> ${LOG} 2>&1 + echo "(provide 'emacs-goodies-loaddefs)" >> emacs-goodies-loaddefs.el +fi + +echo "(setq load-path (cons \".\" load-path) byte-compile-warnings nil)" > path.el +if test "${APPEND_LOAD_PATH}" != "" +then + echo "(setq load-path (append ${APPEND_LOAD_PATH} load-path))" >> path.el +fi + +echo ${FLAVOR} ${FLAGS} ${FILES} >> ${LOG} +"${FLAVOR}" ${FLAGS} ${FILES} >> ${LOG} 2>&1 +egrep -s -e "While compiling|\*\*" ${LOG} || /bin/true +echo install/${PACKAGE}: Deleting ${LOG} +rm -f path.el ${LOG} + +exit 0 + +# Local Variables: +# mode: shell-script +# End: diff --git a/debian/emacsen-remove.template b/debian/emacsen-remove.template new file mode 100644 index 0000000..c84eeb8 --- /dev/null +++ b/debian/emacsen-remove.template @@ -0,0 +1,5 @@ + +if [ ${FLAVOR} != emacs ]; then + echo remove/${PACKAGE}: purging byte-compiled files for ${FLAVOR} + rm -rf /usr/share/${FLAVOR}/site-lisp/${PACKAGE} +fi diff --git a/debian/patches/40_missing_provide.diff b/debian/patches/40_missing_provide.diff new file mode 100644 index 0000000..077d557 --- /dev/null +++ b/debian/patches/40_missing_provide.diff @@ -0,0 +1,10 @@ +## 40_missing_provide.diff by Peter S Galbraith + +--- a/elisp/emacs-goodies-el/align-string.el ++++ b/elisp/emacs-goodies-el/align-string.el +@@ -98,3 +98,5 @@ + (setq i (1+ i))))) + ;; Clear end marker. + (set-marker end nil))) ++ ++(provide 'align-string) diff --git a/debian/patches/49_bar-cursor-customize.diff b/debian/patches/49_bar-cursor-customize.diff new file mode 100644 index 0000000..6f28b3b --- /dev/null +++ b/debian/patches/49_bar-cursor-customize.diff @@ -0,0 +1,162 @@ +## 49_bar-cursor-customize.diff by Peter S Galbraith + +--- a/elisp/emacs-goodies-el/bar-cursor.el 2003-10-05 15:12:44.000000000 -0400 ++++ b/elisp/emacs-goodies-el/bar-cursor.el 2003-10-05 15:14:54.000000000 -0400 +@@ -3,7 +3,7 @@ + + ;; This file is not part of Emacs + +-;; Copyright (C) 2001 by Joseph L. Casadonte Jr. ++;; Copyright (C) 2001, 2003 by Joseph L. Casadonte Jr. + ;; Author: Joe Casadonte (emacs@northbound-train.com) + ;; Maintainer: Joe Casadonte (emacs@northbound-train.com) + ;; Created: July 1, 2001 +@@ -44,13 +44,17 @@ + ;; + ;; To add a directory to your load-path, use something like the following: + ;; +-;; (add-to-list 'load-path (expand-file-name "/some/load/path")) ++;; (add-to-list 'load-path (expand-file-name "/some/load/path")) + + ;;; Usage: + ;; + ;; M-x `bar-cursor-mode' + ;; Toggles bar-cursor-mode on & off. Optional arg turns +-;; bar-cursor-mode on iff arg is a positive integer. ++;; bar-cursor-mode on if arg is a positive integer. ++;; ++;; You may also use the custom interface to enable or disable it: ++;; ++;; M-x customize-variable [RET] bar-cursor-mode [RET] + + ;;; To Do: + ;; +@@ -60,6 +64,9 @@ + ;; + ;; The basis for this code comes from Steve Kemp by way of the + ;; NTEmacs mailing list. ++;; ++;; Peter S. Galbraith contributed a patch making ++;; bar-cursor-mode customizable. + + ;;; Comments: + ;; +@@ -85,7 +92,9 @@ + (eval-when-compile + ;; silence the old byte-compiler + (defvar byte-compile-dynamic nil) +- (set (make-local-variable 'byte-compile-dynamic) t)) ++ (set (make-local-variable 'byte-compile-dynamic) t) ++ (require 'advice) ++ (defvar bar-cursor-mode)) + + ;;; ************************************************************************** + ;;; ***** version related routines +@@ -109,43 +118,43 @@ + ;;; ************************************************************************** + ;;; ***** real functions + ;;; ************************************************************************** +-(defvar bar-cursor-mode nil "Non-nil if 'bar-cursor-mode' is enabled.") + +-;;; -------------------------------------------------------------------------- + ;;;###autoload + (defun bar-cursor-mode (&optional arg) +- "Toggle use of 'bar-cursor-mode'. +- ++ "Toggle use of variable `bar-cursor-mode'. + This quasi-minor mode changes cursor to a bar cursor in insert mode, + and a block cursor in overwrite mode. It may only be turned on and + off globally, not on a per-buffer basis (hence the quasi- designation). + +-Optional ARG turns mode on iff ARG is a positive integer." ++Optional ARG turns mode on if ARG is a positive integer." + (interactive "P") + + ;; toggle on and off + (let ((old-mode bar-cursor-mode)) +- (setq bar-cursor-mode +- (if arg (or (listp arg) +- (> (prefix-numeric-value arg) 0)) +- (not bar-cursor-mode))) ++ (setq bar-cursor-mode ++ (if arg (or (listp arg) ++ (> (prefix-numeric-value arg) 0)) ++ (not bar-cursor-mode))) ++ ++ (when (not (equal old-mode bar-cursor-mode)) ++ (bar-cursor-change)))) + +- (when (not (equal old-mode bar-cursor-mode)) +- ;; enable/disable advice +- (if bar-cursor-mode +- (ad-enable-advice 'overwrite-mode 'after 'bar-cursor-overwrite-mode-ad) +- (ad-disable-advice 'overwrite-mode 'after 'bar-cursor-overwrite-mode-ad)) ++;;;###autoload ++(defun bar-cursor-change () ++ "Enable or disable advice based on value of variable `bar-cursor-mode'." ++ (if bar-cursor-mode ++ (ad-enable-advice 'overwrite-mode 'after 'bar-cursor-overwrite-mode-ad) ++ (ad-disable-advice 'overwrite-mode 'after 'bar-cursor-overwrite-mode-ad)) + +- (ad-activate 'overwrite-mode) ++ (ad-activate 'overwrite-mode) + +- ;; set the initial cursor type now +- (bar-cursor-set-cursor) ++ ;; set the initial cursor type now ++ (bar-cursor-set-cursor) + +- ;; add or remove to frame hook +- (if bar-cursor-mode +- (add-hook 'after-make-frame-functions 'bar-cursor-set-cursor) +- (remove-hook 'after-make-frame-functions 'bar-cursor-set-cursor)) +- ))) ++ ;; add or remove to frame hook ++ (if bar-cursor-mode ++ (add-hook 'after-make-frame-functions 'bar-cursor-set-cursor) ++ (remove-hook 'after-make-frame-functions 'bar-cursor-set-cursor))) + + ;;;-------------------------------------------------------------------------- + (defadvice overwrite-mode (after bar-cursor-overwrite-mode-ad disable) +@@ -154,7 +163,7 @@ + + ;;;-------------------------------------------------------------------------- + (defun bar-cursor-set-cursor-type (cursor &optional frame) +- "Set the cursor-type for the named frame. ++ "Set the `cursor-type' for the named frame. + + CURSOR is the name of the cursor to use (bar or block -- any others?). + FRAME is optional frame to set the cursor for; current frame is used +@@ -169,7 +178,7 @@ + + ;;; -------------------------------------------------------------------------- + (defun bar-cursor-set-cursor (&optional frame) +- "Set the cursor-type according to the insertion mode. ++ "Set the `cursor-type' according to the insertion mode. + + FRAME is optional frame to set the cursor for; current frame is used + if not passed in." +@@ -177,6 +186,23 @@ + (bar-cursor-set-cursor-type 'bar frame) + (bar-cursor-set-cursor-type 'block frame))) + ++;;; -------------------------------------------------------------------------- ++(defgroup bar-cursor nil ++ "switch block cursor to a bar." ++ :group 'convenience) ++ ++(defcustom bar-cursor-mode nil ++ "*Non-nil means to convert the block cursor into a bar cursor. ++In overwrite mode, the bar cursor changes back into a block cursor. ++This is a quasi-minor mode, meaning that it can be turned on & off easily ++though only globally (hence the quasi-)" ++ :type 'boolean ++ :group 'bar-cursor ++ :require 'bar-cursor ++ :set (lambda (symbol value) ++ (set-default symbol value) ++ (bar-cursor-change))) ++ + ;;; ************************************************************************** + ;;; ***** we're done + ;;; ************************************************************************** diff --git a/debian/patches/50_bar-cursor_bug331430.diff b/debian/patches/50_bar-cursor_bug331430.diff new file mode 100644 index 0000000..2594684 --- /dev/null +++ b/debian/patches/50_bar-cursor_bug331430.diff @@ -0,0 +1,13 @@ +## 50_bar-cursor_bug331430.diff by Peter S Galbraith + +--- a/elisp/emacs-goodies-el/bar-cursor.el ++++ b/elisp/emacs-goodies-el/bar-cursor.el +@@ -184,7 +184,7 @@ + if not passed in." + (if (and bar-cursor-mode (not overwrite-mode)) + (bar-cursor-set-cursor-type 'bar frame) +- (bar-cursor-set-cursor-type 'block frame))) ++ (bar-cursor-set-cursor-type 'box frame))) + + ;;; -------------------------------------------------------------------------- + (defgroup bar-cursor nil diff --git a/debian/patches/50_browse-kill-ring_bug224751.diff b/debian/patches/50_browse-kill-ring_bug224751.diff new file mode 100644 index 0000000..dacb6fd --- /dev/null +++ b/debian/patches/50_browse-kill-ring_bug224751.diff @@ -0,0 +1,16 @@ +## 50_browse-kill-ring_bug224751.diff by Peter S Galbraith + +--- a/elisp/emacs-goodies-el/browse-kill-ring.el 2009-09-03 09:43:06.000000000 -0400 ++++ b/elisp/emacs-goodies-el/browse-kill-ring.el 2009-09-03 09:55:51.000000000 -0400 +@@ -591,7 +591,10 @@ + (unwind-protect + (progn + (setq buffer-read-only nil) +- (let ((target (overlay-get over 'browse-kill-ring-target))) ++ (let ((target (overlay-get over 'browse-kill-ring-target)) ++ ;; See http://bugs.debian.org/224751 ++ ;; Emacs 21.1 fails when text was read-only ++ (inhibit-read-only t)) + (delete-region (overlay-start over) + (1+ (overlay-end over))) + (setq kill-ring (delete target kill-ring))) diff --git a/debian/patches/50_coffee_no-autoload.diff b/debian/patches/50_coffee_no-autoload.diff new file mode 100644 index 0000000..bcb1a30 --- /dev/null +++ b/debian/patches/50_coffee_no-autoload.diff @@ -0,0 +1,12 @@ +## 50_coffee_no-autoload.diff by Peter S Galbraith + +--- a/elisp/emacs-goodies-el/coffee.el 2004-01-15 16:22:57.000000000 -0500 ++++ b/elisp/emacs-goodies-el/coffee.el 2004-01-15 16:25:46.000000000 -0500 +@@ -69,7 +69,6 @@ + ("Sweetener" . ,coffee-sweetener-types) + ("Alcohol" . ,coffee-alcohol-types))) + +-;;;###autoload + (defun coffee () + "Submit a BREW request to an RFC2324-compliant coffee device" + (interactive) diff --git a/debian/patches/50_color-theme_custom.diff b/debian/patches/50_color-theme_custom.diff new file mode 100644 index 0000000..bb05d7a --- /dev/null +++ b/debian/patches/50_color-theme_custom.diff @@ -0,0 +1,26 @@ +## 50_color-theme_custom.diff by Peter S Galbraith + +--- a/elisp/emacs-goodies-el/color-theme.el ++++ b/elisp/emacs-goodies-el/color-theme.el +@@ -221,7 +221,9 @@ + (defcustom color-theme-libraries (directory-files + (concat + (file-name-directory (locate-library "color-theme")) +- "/themes") t "^color-theme") ++;;; Debian doesn't use the "/themes" subdirectory and uses the prefix ++;;; "^color-theme-" instead of simply "^color-theme" to accomodate this. ++ "") 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 +--- a/elisp/emacs-goodies-el/color-theme-library.el ++++ b/elisp/emacs-goodies-el/color-theme-library.el +@@ -30,6 +30,8 @@ + (eval-when-compile + (require 'color-theme)) + ++(require 'info) ++ + (defun color-theme-gnome () + "Wheat on darkslategrey scheme. + From one version of Emacs in RH6 and Gnome, modified by Jonadab." diff --git a/debian/patches/50_ctypes.diff b/debian/patches/50_ctypes.diff new file mode 100644 index 0000000..9751cd6 --- /dev/null +++ b/debian/patches/50_ctypes.diff @@ -0,0 +1,303 @@ +## 50_ctypes.diff by Peter S Galbraith + +--- a/elisp/emacs-goodies-el/ctypes.el ++++ b/elisp/emacs-goodies-el/ctypes.el +@@ -4,9 +4,9 @@ + + ;; Author: Anders Lindgren + ;; Maintainer: Anders Lindgren +-;; Version: 1.3.1 ++;; Version: 1.4 by Peter S Galbraith + ;; Created: 1997-03-16 +-;; Date: 1999-06-23 ++;; Date: 2003-11-10 + + ;; CTypes is free software; you can redistribute it and/or modify + ;; it under the terms of the GNU General Public License as published by +@@ -228,14 +228,26 @@ + + ;;}}} + ++;;; History: ++;; ++;; 1.3.1 is from http://www.juliocastillo.com/emacs/site-lisp/ctypes.el ++;; ++;; 1.4 Peter S Galbraith ++;; I can't find the author, so did a few changes myself. ++;; - minor checkdoc changes (it still lists 43 documentation errors). ++;; - custom support. ++;; - add defcustom `ctypes-install' for easier setup in Debian package ++;; emacs-goodies-el. ++ + ;;; Code: + + ;;{{{ Dependencies + +-;; The only reason to load font-lock is to determinate the font-lock ++;; The only reason to load font-lock is to determine the font-lock + ;; version we are using. + + (require 'font-lock) ++(require 'cc-mode) + + (eval-when-compile + (require 'cl)) +@@ -243,19 +255,38 @@ + ;;}}} + ;;{{{ Variables + +-(defvar ctypes-file-name "~/.ctypes" +- "*Default name of file to read types from. ++(defgroup ctypes nil ++ "Enhanced Font lock support for custom defined types." ++ :group 'programming) ++ ++(defcustom ctypes-install nil ++ "*Whether to load this file at macs startup. ++Setting this variable will load the file to install the 'find-file-hooks ++and 'kill-emacs-hook hooks. The effect is the same as adding ++ (require 'ctypes) ++in your Emacs initilization file. ++The file ctypes.el must be in the Emacs load-path when the customization ++code is run in .emacs otherwise Emacs will not find it and will yield an ++error." ++ :type 'boolean ++ :require 'ctypes ++ :group 'ctypes) + ++(defcustom ctypes-file-name "~/.ctypes" ++ "*Default name of file to read types from. + When `ctypes-read-file' and `ctypes-write-file' are called interactively +-the directory part of the file name is ignored.") +- ++the directory part of the file name is ignored." ++ :type 'file ++ :group 'ctypes) + +-(defvar ctypes-write-types-at-exit nil ++(defcustom ctypes-write-types-at-exit nil + "*When non-nil types are saved to file when Emacs exits. +- +-When this variable be 'ask, the user is prompted before the +-types are saved.") +- ++When this variable be 'ask, the user is prompted before the types are saved." ++ :type '(choice ++ (const :tag "t; save to file when Emacs exits" t) ++ (const :tag "nil; do not save to file when Emacs exits" nil) ++ (const :tag "ask; prompt before saving" ask)) ++ :group 'ctypes) + + (defvar ctypes-mode-descriptor + (if (boundp 'c-font-lock-extra-types) +@@ -300,13 +331,13 @@ + when the function is called.") + + +-(defvar ctypes-dir-read-file nil +- "*Variable determinating which files `ctypes-dir' should read. ++(defcustom ctypes-dir-read-file nil ++ "*Variable determining which files `ctypes-dir' should read. + +-When search for types in a large number of files it is difficult +-to determine which files to parse. Should to few be opened, we +-can miss some types. The opposite, to open to many be opened, +-the parse process could take much longer than needed. ++When searching for types in a large number of files it is difficult to ++determine which files to parse. Some types can be missed should too few ++file be opened, and the parse process could take much longer than needed ++with too many files. + + The default behavior, when `ctypes-dir-read-file' is nil, is to look + at the extension of the files found. Should it match a major mode in +@@ -331,11 +362,29 @@ + (setq ctypes-dir-read-file \"\\\\.cplusplus\\\\'\") + + However, the files would still need a -*- C++ -*- header line +-to be parsed as C++ files.") +- ++to be parsed as C++ files." ++ :type '(choice (const :tag "nil; fast approach." nil) ++ (const :tag "t; read all non-backup files" t) ++ (regexp :tag "regexp to match files")) ++ :group 'ctypes) ++ ++(defcustom ctypes-dir-backup-files nil ++ "*Non-nil means that `ctypes-dir' should parse backup files." ++ :type 'boolean ++ :group 'ctypes) ++ ++(defcustom ctypes-auto-parse-mode-hook nil ++ "*List of functions to run when `ctypes-auto-parse-mode' is activated." ++ :type 'hook ++ :group 'ctypes) ++ ++(defcustom ctypes-load-hook nil ++ "*List of functions to run when `ctypes' is loaded." ++ :type 'hook ++ :group 'ctypes) + +-(defvar ctypes-dir-backup-files nil +- "*Non-nil means that `ctypes-dir' should parse backup files.") ++(defvar ctypes-saved-p t ++ "Nil when types not saved to file.") + + (defvar ctypes-auto-parse-mode nil + "Non-nil when the minor mode `ctypes-auto-parse-mode' is enabled. +@@ -346,18 +395,6 @@ + To start the mode call the function `ctypes-auto-parse-mode', do not + set this variable explicitly.") + +- +-(defvar ctypes-auto-parse-mode-hook nil +- "*List of functions to run when `ctypes-auto-parse-mode' is activated.") +- +-(defvar ctypes-load-hook nil +- "*List of functions to run when `ctypes' is loaded.") +- +- +-(defvar ctypes-saved-p t +- "Nil when types not saved to file.") +- +- + (defvar ctypes-repetitive-type-regexp + (concat "\\<\\(short\\|int\\|long\\|float\\|" + "double\\|char\\|\\(un\\)?signed\\|const\\)\\>") +@@ -387,7 +424,7 @@ + When preceded by C-u the display is not updated. + + Return non-nil if the type was not known before." +- (interactive ++ (interactive + (list + (let* ((default (ctypes-get-type-under-point)) + (prompt (if default +@@ -400,7 +437,7 @@ + (error "Can't define \"\" as a type")) + (or mode + (setq mode major-mode)) +- (and type ++ (and type + (> (length type) 0) + (let ((added (ctypes-add-types mode (list type)))) + (ctypes-perform-action mode added delay-action) +@@ -552,7 +589,7 @@ + When preceded by C-u the display is not updated. + + Return non-nil if type is removed." +- (interactive ++ (interactive + (list + (let* ((default (ctypes-get-type-under-point)) + (prompt (if default +@@ -828,7 +865,7 @@ + ;;{{{ Edit + + (defvar ctypes-edit-map nil +- "Keymap used in ctypes-edit mode.") ++ "Keymap used in `ctypes-edit' mode.") + (if ctypes-edit-map + nil + (setq ctypes-edit-map (make-sparse-keymap)) +@@ -1087,7 +1124,7 @@ + + + (defun ctypes-subset (type-list1 type-list2) +- "Non-nil if type-list1 is included in type-list2." ++ "Non-nil if TYPE-LIST1 is included in TYPE-LIST2." + (let ((included t)) + (while (and included type-list1) + (if (not (member (car type-list1) type-list2)) +@@ -1127,7 +1164,7 @@ + + The action is performed immediately for major modes in MODES, and for + major modes that inherits types from modes in MODES, when +-`delay-action' is nil, and either changed-p is non-nil or the modes ++`delay-action' is nil, and either CHANGED-P is non-nil or the modes + previously have been marked for delayed action. + + Should DELAY-ACTION be non-nil, the actions are not performed +@@ -1189,7 +1226,7 @@ + + + (defun ctypes-perform-delayed-action () +- "Perform the action (normally update the display)" ++ "Perform the action (normally update the display)." + (ctypes-perform-action ctypes-delayed-action-list nil nil)) + + ;;}}} +@@ -1243,7 +1280,7 @@ + (set (make-local-variable 'parse-sexp-ignore-comments) t) + (unwind-protect + (let ((lst '())) +- (while (re-search-forward ++ (while (re-search-forward + "^\\(\\(typedef\\)\\|class\\|struct\\|enum\\)\\>" nil t) + (condition-case () + (if (match-beginning 2) +@@ -1494,15 +1531,15 @@ + (forward-char -1) + (goto-char end)) + (skip-chars-backward " \t") +- (setq modes +- (cons (intern +- (concat +- (downcase ++ (setq modes ++ (cons (intern ++ (concat ++ (downcase + (buffer-substring beg (point))) "-mode")) + modes))) + ;; Simple -*-MODE-*- case. +- (setq modes +- (cons (intern ++ (setq modes ++ (cons (intern + (concat (downcase (buffer-substring beg end)) + "-mode")) + modes)))))) +@@ -1559,7 +1596,7 @@ + + + (defun ctypes-string-to-mode (mode) +- "Convert a mode name, entered by the user, to a mode symbol. ++ "Convert a MODE name, entered by the user, to a mode symbol. + + Example: + (ctypes-string-to-mode \"C++\") => c++-mode" +@@ -1659,7 +1696,7 @@ + ;; Fontify each declaration item. + (list 'font-lock-match-c++-style-declaration-item-and-skip-to-next + ;; Start with point after all type specifiers. +- (list 'goto-char ++ (list 'goto-char + (list 'or (list 'match-beginning + (+ 2 (regexp-opt-depth regexp))) + '(match-end 1))) +@@ -1682,7 +1719,7 @@ + ((= number 2) + (setq keywords keyword-2)) + (t +- (error "Incorrect entry in rule. Found `%s', expected 1 or 2." ++ (error "Incorrect entry in rule. Found `%s', expected 1 or 2" + number))) + (if append-p + (set var (append (symbol-value var) (list keywords))) +@@ -1730,13 +1767,11 @@ + + ;;}}} + +-;; The End +- ++;; Install ourself + (add-hook 'find-file-hooks 'ctypes-find-file-hook) + (add-hook 'kill-emacs-hook 'ctypes-kill-emacs-hook) + +-(provide 'ctypes) +- + (run-hooks 'ctypes-load-hook) ++(provide 'ctypes) + +-;; ctypes.el ends here. ++;;; ctypes.el ends here diff --git a/debian/patches/50_dedicated.diff b/debian/patches/50_dedicated.diff new file mode 100644 index 0000000..9384188 --- /dev/null +++ b/debian/patches/50_dedicated.diff @@ -0,0 +1,53 @@ +## 50_dedicated.diff by Peter S Galbraith + +--- a/elisp/emacs-goodies-el/dedicated.el 2003-11-12 20:51:41.000000000 -0500 ++++ b/elisp/emacs-goodies-el/dedicated.el 2003-11-12 20:18:53.000000000 -0500 +@@ -4,7 +4,7 @@ + + ;; Author: Eric Crampton + ;; Maintainer: Eric Crampton +-;; Version: 1.0.0 ++;; Version: 1.1.0 + ;; Keywords: dedicated, buffer + + ;; This file is not part of GNU Emacs. +@@ -34,16 +34,30 @@ + ;; + ;; Dedicated buffers will have "D" shown in the mode line. + ++;;; History: ++;; ++;; 2003-11-12 Peter S Galbraith ++;; V1.0.0 found on gnu.emacs.sources archives for 2000/04/12: ++;; http://groups.google.com/groups?selm=izn1mzrs60.fsf%40elmo.atdesk.com ++;; V1.1.0 made `dedicated-mode' a true toggle; added autoload tag and made ++;; minor checkdoc edits. ++ + ;;; Code: + + (defvar dedicated-mode nil +- "Mode variable for dedicated minor mode.") ++ "Mode variable for dedicated minor mode. ++Use the command `dedicated-mode' to toggle or set this variable.") + (make-variable-buffer-local 'dedicated-mode) + ++;;;###autoload + (defun dedicated-mode (&optional arg) +- "Dedicated minor mode." ++ "Toggle dedicated minor mode. ++With ARG, turn minor mode on if ARG is positive, off otherwise." + (interactive "P") +- (setq dedicated-mode (not dedicated-mode)) ++ (setq hs-headline nil ++ dedicated-mode (if (null arg) ++ (not dedicated-mode) ++ (> (prefix-numeric-value arg) 0))) + (set-window-dedicated-p (selected-window) dedicated-mode) + (if (not (assq 'dedicated-mode minor-mode-alist)) + (setq minor-mode-alist +@@ -51,3 +65,5 @@ + minor-mode-alist)))) + + (provide 'dedicated) ++ ++;;; dedicated.el ends here diff --git a/debian/patches/50_diminish-defcustom.diff b/debian/patches/50_diminish-defcustom.diff new file mode 100644 index 0000000..1afce39 --- /dev/null +++ b/debian/patches/50_diminish-defcustom.diff @@ -0,0 +1,153 @@ +## 50_diminish-defcustom.diff by Peter S Galbraith + +--- a/elisp/emacs-goodies-el/diminish.el 2003-06-17 21:01:24.000000000 -0400 ++++ b/elisp/emacs-goodies-el/diminish.el 2003-06-18 19:51:22.000000000 -0400 +@@ -1,11 +1,11 @@ + ;;; diminish.el --- Diminished modes are minor modes with no modeline display + +-;; Copyright (C) 1998 Free Software Foundation, Inc. ++;; Copyright (C) 1998, 2003 Free Software Foundation, Inc. + + ;; Author: Will Mengarini + ;; URL: + ;; Created: Th 19 Feb 98 +-;; Version: 0.44, Sa 23 Jan 99 ++;; Version: 0.45, 18 Jun 2003 + ;; Keywords: extensions, diminish, minor, codeprose + + ;; This file is part of GNU Emacs. +@@ -95,6 +95,11 @@ + ;; near the end of your .emacs file. It should be near the end so that any + ;; minor modes your .emacs loads will already have been loaded by the time + ;; they're to be converted to diminished modes. ++;; ++;; Alternatively, you can setup dimished modes using the customize ++;; interface by customizing the variable `diminished-minor-modes'. The ++;; same caveat as above applies and the minor mode libraries should be ++;; loaded in ~/.emacs before the `(custom-set-variables' line. + + ;; To diminish a major mode, (setq mode-name "whatever") in the mode hook. + +@@ -104,6 +109,21 @@ + ;; by our facility with language." + ;; --J. Michael Straczynski + ++ ++;;; History: ++;; ++;; 2003-06-08 Peter S. Galbraith ++;; ++;; - Make diminished-minor-modes a defcustom. You can now setup the ++;; package using `M-x customize-variable[RET]diminished-minor-modes[RET]'. ++;; ++;; The minor modes still need to be loaded in ~/.emacs prior to diminish ++;; setup but I'm not too sure how to best handle that. An list of ++;; (MINOR-MODE . LIBRARY-FILE) obtained by pre-parsing the Emacs elisp ++;; files perhaps, and then add an eval-after-load? Seems like a kludge ++;; because it relies on outside information remaining constant, but it ++;; would help. ++ + ;;; Code: + + (eval-when-compile (require 'cl)) +@@ -152,7 +172,7 @@ + ;; perhaps at first in surprise, the freedom they thus gain, and grow strong. + + ;;;###autoload +-(defun diminish (mode &optional to-what) ++(defun diminish (mode &optional to-what annotate-flag) + "Diminish mode-line display of minor mode MODE to TO-WHAT (default \"\"). + + Interactively, enter (with completion) the name of any minor mode, followed +@@ -167,7 +187,10 @@ + letters for some modes, without leading spaces. Capitalizing them works + best; if you then diminish some mode to \"X\" but have abbrev-mode enabled as + well, you'll get a display like \"AbbrevX\". This function prepends a space +-to TO-WHAT if it's > 1 char long & doesn't already begin with a space." ++to TO-WHAT if it's > 1 char long & doesn't already begin with a space. ++ ++If ANNOTATE-FLAG is nil or omitted, the normal case in interactive use, then ++the variable `diminished-minor-modes' will be modified to reflect the change." + (interactive (list (read (completing-read + "Diminish what minor mode: " + (mapcar (lambda (x) (list (symbol-name (car x)))) +@@ -184,7 +207,11 @@ + (callf2 concat " " to-what))) + (or (assq mode diminished-mode-alist) + (push (copy-sequence minor) diminished-mode-alist)) +- (setcdr minor (list to-what)))) ++ (setcdr minor (list to-what)) ++ (if (not annotate-flag) ++ (setq diminished-minor-modes ++ (append diminished-minor-modes ++ (list (cons (car minor) to-what))))))) + + ;; But an image comes to me, vivid in its unreality, of a loon alone on his + ;; forest lake, shrieking his soul out into a canopy of stars. Alone this +@@ -203,7 +230,7 @@ + ;; He was shot dead by police. + + ;;;###autoload +-(defun diminish-undo (mode) ++(defun diminish-undo (mode &optional annotate-flag) + "Restore mode-line display of diminished mode MODE to its minor-mode value. + Do nothing if the arg is a minor mode that hasn't been diminished. + +@@ -211,7 +238,10 @@ + mode that was formerly a minor mode on which you invoked M-x diminish). + To restore all diminished modes to minor status, answer `diminished-modes'. + The response to the prompt shouldn't be quoted. However, in Lisp code, +-the arg must be quoted as a symbol, as in (diminish-undo 'diminished-modes)." ++the arg must be quoted as a symbol, as in (diminish-undo 'diminished-modes). ++ ++If ANNOTATE-FLAG is nil or omitted, the normal case in interactive use, then ++the variable `diminished-minor-modes' will be modified to reflect the change." + (interactive + (list (read (completing-read + "Restore what diminished mode: " +@@ -229,7 +259,10 @@ + (or minor + (error "%S is not currently registered as a minor mode" mode)) + (when diminished +- (setcdr minor (cdr diminished)))))) ++ (setcdr minor (cdr diminished)) ++ (when (not annotate-flag) ++ (setq diminished-minor-modes ++ (assq-delete-all (car minor) diminished-minor-modes))))))) + + ;; Plumber Bob was not from Seattle, my grey city, for rainy Seattle is a + ;; city of interiors, a city of the self-diminished. When I moved here one +@@ -288,6 +321,31 @@ + ;; in line with the ducks and geese at the espresso counter, gazing placidly + ;; out on the world through loon-red eyes, thinking secret thoughts. + ++(defgroup diminish nil ++ "Diminished modes are minor modes with no modeline display." ++ :group 'convenience) ++ ++(defcustom diminished-minor-modes nil ++ "List of minor modes to diminish and their mode line display strings. ++The display string can be the empty string if you want the name of the mode ++completely removed from the mode line. If you prefer, you can abbreviate ++the name. For 2 characters or more will be displayed as a separate word on ++the mode line, just like minor modes' names. A single character will be ++scrunched up against the previous word. Multiple single-letter diminished ++modes will all be scrunched together. ++ ++The display of undiminished modes will not be affected." ++ :group 'diminish ++ :type '(alist :key-type (symbol :tag "Minor-mode") ++ :value-type (string :tag "Title")) ++ :options (mapcar 'car minor-mode-alist) ++ :set (lambda (symbol value) ++ (if (and (boundp 'diminished-minor-modes) diminished-minor-modes) ++ (mapcar ++ (lambda (x) (diminish-undo (car x) t)) diminished-minor-modes)) ++ (set-default symbol value) ++ (mapcar (lambda (x) (diminish (car x) (cdr x) t)) value))) ++ + (provide 'diminish) + +-;;; diminish.el ends here +\ No newline at end of file ++;;; diminish.el ends here diff --git a/debian/patches/50_edit-env_autoload.diff b/debian/patches/50_edit-env_autoload.diff new file mode 100644 index 0000000..72f296e --- /dev/null +++ b/debian/patches/50_edit-env_autoload.diff @@ -0,0 +1,12 @@ +## 50_edit-env_autoload.diff by Peter S Galbraith + +--- a/elisp/emacs-goodies-el/edit-env.el 2003-11-12 20:17:21.000000000 -0500 ++++ b/elisp/emacs-goodies-el/edit-env.el 2003-11-14 15:00:01.000000000 -0500 +@@ -111,6 +111,7 @@ + (list (widget-get widget 'environment-variable-name) + widget))) + ++;;;###autoload + (defun edit-env () + "Display, edit, delete and add environment variables." + (interactive) diff --git a/debian/patches/50_filladapt_bug420845.diff b/debian/patches/50_filladapt_bug420845.diff new file mode 100644 index 0000000..3b5ca7f --- /dev/null +++ b/debian/patches/50_filladapt_bug420845.diff @@ -0,0 +1,21 @@ +## 50_filladapt_bug420845.diff by + +--- a/elisp/emacs-goodies-el/filladapt.el 2003-04-04 15:16:01.000000000 -0500 ++++ b/elisp/emacs-goodies-el/filladapt.el 2007-05-14 19:41:02.000000000 -0400 +@@ -72,7 +72,7 @@ + + (provide 'filladapt) + +-(defvar filladapt-version "2.12" ++(defvar filladapt-version "2.12debian" + "Version string for filladapt.") + + ;; BLOB to make custom stuff work even without customize +@@ -620,6 +620,7 @@ + + (defun turn-on-filladapt-mode () + "Unconditionally turn on Filladapt mode in the current buffer." ++ (interactive) + (filladapt-mode 1)) + + (defun turn-off-filladapt-mode () diff --git a/debian/patches/50_gnus-BTS.diff b/debian/patches/50_gnus-BTS.diff new file mode 100644 index 0000000..f50503c --- /dev/null +++ b/debian/patches/50_gnus-BTS.diff @@ -0,0 +1,186 @@ +## 50_gnus-BTS.diff by Peter S Galbraith + +--- a/elisp/debian-el/gnus-BTS.el 2005-09-15 21:38:07.000000000 -0400 ++++ b/elisp/debian-el/gnus-BTS.el 2005-09-19 18:54:07.000000000 -0400 +@@ -33,42 +33,74 @@ + ;; references to the Bug Tracking system in them. It expects to see + ;; Bug references in the form of (for example): "#48273", "closes: + ;; 238742" or similar. ++;; ++;; Use `M-x' `gnus-dbts-browse-debpkg-or-bug' over the bug number. + ++;;; Change log: ++;; 2005-08-20 Jari Aalto ++;; ++;; * gnus-BTS.el: ++;; (top level): Changed all variable and function names to use common ++;; prefix `gnus-dbts-'. This makes package namespace clean. Converted ++;; all lambda forms to real functions. Cleaned up ++;; `gnus-select-article-hook' setting. ++;; Changed all 'setq' to 'defvar'. ++;; (gnus-dbts-gnus-install): New. ++;; (gnus-dbts-gnus-select-article-hook): New. ++;; (gnus-dbts-buttonize): New. ++;; (eval-after-load): New. Install at point when Gnus is being loaded. ++;; ++;; 2005-09-19 Peter S Galbraith ++;; ++;; Minor bug fix: gnus-dbts-gnus-install missing brackets. ++;; + ;;; Code: + + +-(setq anti-bug-special-keywords "reassign\\|merge") +-(setq anti-bug-keywords (concat +- "tags\\|severity\\|retitle\\|close\\|closes:\\|Merged\\|reopen\\|Bug\\|" +- anti-bug-special-keywords)) ++;; gnus-dbts = Gnus inerface to Debian Bug Tracking System + +-(setq anti-bug-prefix " *#?\\|Bugs?\\|#") +-(setq anti-bug-number " *\\([0-9]+\\)") +-(setq anti-bug-special " +\\([0-9]+\\|[-.A-Za-z0-9]+\\)") ++(autoload 'thing-at-point "thingatpt") + +-(setq anti-gnus-debian-bug-regexp (concat +- "\\(" +- "\\(" +- anti-bug-keywords +- "\\)" +- anti-bug-prefix +- "\\)" +- anti-bug-number)) ++(defvar gnus-dbts-in-debian-group-p nil) + +-(setq anti-gnus-debian-reassign-or-merge-regexp +- (concat +- "\\(" +- anti-bug-special-keywords +- "\\)" +- anti-bug-number +- anti-bug-special)) ++(defvar gnus-dbts-in-debian-devel-announce-group-p nil) + +-(setq anti-gnus-debian-reassign-regexp "reassigned from package `\\([^']*\\)' to `\\([^']*\\)'") +-(setq anti-gnus-debian-bug-BTS-regexp "^ *\\([0-9]+\\)") ++(defvar gnus-dbts-bug-special-keywords "reassign\\|merge") + +-(defun anti-browse-debpkg-or-bug (thing) ++(defvar gnus-dbts-bug-keywords ++ (concat ++ "tags\\|severity\\|retitle\\|close\\|closes:\\|Merged\\|reopen\\|Bug\\|" ++ gnus-dbts-bug-special-keywords)) ++ ++(defvar gnus-dbts-bug-prefix " *#?\\|Bugs?\\|#") ++(defvar gnus-dbts-bug-number " *\\([0-9]+\\)") ++(defvar gnus-dbts-bug-special " +\\([0-9]+\\|[-.A-Za-z0-9]+\\)") ++ ++(defvar gnus-dbts-debian-bug-regexp ++ (concat ++ "\\(" ++ "\\(" ++ gnus-dbts-bug-keywords ++ "\\)" ++ gnus-dbts-bug-prefix ++ "\\)" ++ gnus-dbts-bug-number)) ++ ++(defvar gnus-dbts-debian-reassign-or-merge-regexp ++ (concat ++ "\\(" ++ gnus-dbts-bug-special-keywords ++ "\\)" ++ gnus-dbts-bug-number ++ gnus-dbts-bug-special)) ++ ++(defvar gnus-dbts-debian-reassign-regexp ++ "reassigned from package `\\([^']*\\)' to `\\([^']*\\)'") ++ ++(defvar gnus-dbts-debian-bug-regexp "^ *\\([0-9]+\\)") ++ ++(defun gnus-dbts-browse-debpkg-or-bug (thing) + (interactive "i") +- (require 'thingatpt) + (let* ((the-thing (if (null thing) + (thing-at-point 'sexp) + thing)) +@@ -80,45 +112,48 @@ + the-thing)) + (url (if bugp + "http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=" +- "http://cgi.debian.org/cgi-bin/search_packages.pl?&searchon=names&version=all&release=all&keywords="))) ++ (concat ++ "http://bugs.debian.org/cgi-bin/bugreport.cgi" ++ "?&searchon=names&version=all&release=all&keywords=")))) + (browse-url (concat url bug-or-feature)))) + +-(defvar in-debian-group-p nil) +-(add-hook 'gnus-select-article-hook +- (lambda () +- (setq in-debian-group-p (string-match "debian" +- (gnus-group-real-name +- gnus-newsgroup-name))))) +- +-(defvar in-debian-devel-announce-group-p nil) +-(add-hook 'gnus-select-article-hook +- (lambda () +- (setq in-debian-devel-announce-group-p +- (string-match "debian.devel.announce" +- (gnus-group-real-name +- gnus-newsgroup-name))))) +- +-(defun anti-buttonize-debian (regexp num predicate) ++(defun gnus-dbts-buttonize-debian (regexp num predicate) + (add-to-list 'gnus-button-alist + (list regexp + num + predicate +- 'anti-browse-debpkg-or-bug ++ 'gnus-dbts-browse-debpkg-or-bug + num))) + +-(add-hook +- 'gnus-article-mode-hook ; only run once, as soon as the article buffer has been created. +- (lambda () +- (anti-buttonize-debian anti-gnus-debian-bug-regexp 3 +- 'in-debian-group-p) +- (anti-buttonize-debian anti-gnus-debian-reassign-or-merge-regexp 3 +- 'in-debian-group-p) +- (anti-buttonize-debian anti-gnus-debian-bug-BTS-regexp 1 +- 'in-debian-devel-announce-group-p) +- +- (anti-buttonize-debian anti-gnus-debian-reassign-regexp 1 +- 'in-debian-group-p) +- (anti-buttonize-debian anti-gnus-debian-reassign-regexp 2 +- 'in-debian-group-p))) ++(defun gnus-dbts-buttonize () ++ (gnus-dbts-buttonize-debian gnus-dbts-debian-bug-regexp 3 ++ 'gnus-dbts-in-debian-group-p) ++ (gnus-dbts-buttonize-debian gnus-dbts-debian-reassign-or-merge-regexp 3 ++ 'gnus-dbts-in-debian-group-p) ++ (gnus-dbts-buttonize-debian gnus-dbts-debian-bug-regexp 1 ++ 'gnus-dbts-in-debian-devel-announce-group-p) ++ (gnus-dbts-buttonize-debian gnus-dbts-debian-reassign-regexp 1 ++ 'gnus-dbts-in-debian-group-p) ++ (gnus-dbts-buttonize-debian gnus-dbts-debian-reassign-regexp 2 ++ 'gnus-dbts-in-debian-group-p)) ++ ++(defun gnus-dbts-gnus-select-article-hook () ++ (setq gnus-dbts-in-debian-group-p ++ (string-match "debian" ++ (gnus-group-real-name ++ gnus-newsgroup-name))) ++ (setq gnus-dbts-in-debian-devel-announce-group-p ++ (string-match "debian.devel.announce" ++ (gnus-group-real-name ++ gnus-newsgroup-name)))) ++ ++(defun gnus-dbts-gnus-install () ++ (add-hook 'gnus-select-article-hook 'gnus-dbts-gnus-select-article-hook) ++ ;; only run once, as soon as the article buffer has been created. ++ (add-hook 'gnus-article-mode-hook 'gnus-dbts-buttonize)) ++ ++(eval-after-load "gnus" '(progn (gnus-dbts-gnus-install))) + + (provide 'gnus-BTS) ++ ++;; End of file diff --git a/debian/patches/50_highlight-beyond-fill-column.diff b/debian/patches/50_highlight-beyond-fill-column.diff new file mode 100644 index 0000000..94b1ba9 --- /dev/null +++ b/debian/patches/50_highlight-beyond-fill-column.diff @@ -0,0 +1,181 @@ +## 50_highlight-beyond-fill-column.diff by Peter S Galbraith + +--- a/elisp/emacs-goodies-el/highlight-beyond-fill-column.el 2003-09-19 19:52:15.000000000 -0400 ++++ b/elisp/emacs-goodies-el/highlight-beyond-fill-column.el 2003-09-20 14:26:58.000000000 -0400 +@@ -1,15 +1,16 @@ +-;;; highlight-beyond-fill-column.el --- font-lock-add-keywords aid for Emacs ++;;; highlight-beyond-fill-column.el --- fontify beyond the fill-column. + + ;; Copyright (C) 1985, 1986, 1987, 1992 Free Software Foundation, Inc. ++;; Copyright (C) 2003 Peter S Galbraith + + ;; Author: Sandip Chitale (sandip.chitale@blazesoft.com) + ;; Keywords: programming decipline convenience + + ;; Keywords: + ;; Time-stamp: Aug 23 2001 8:56 PM Pacific Daylight Time +-;; Version: 1.1 ++;; Version: 1.2 + +-;; This file is *NOT* (yet?) part of GNU Emacs. ++;; 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 +@@ -26,10 +27,11 @@ + ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, + ;; Boston, MA 02111-1307, USA. + +-;; Commentary: +- +-;; This defines a function that can be used by `font-lock-add-keywords' to find the columns +-;; that are beyond `fill-column'. ++;;; Commentary: ++;; ++;; This defines a function that can be used by `font-lock-add-keywords' to ++;; find the columns that are beyond `fill-column'. It does not currently ++;; work in XEmacs because it lacks the funcyom `font-lock-add-keywords'. + ;; + ;; Installation: + ;; Put the following in your .emacs +@@ -38,88 +40,70 @@ + ;; + ;; Example usage: + ;; +-;; Customize the `highlight-beyond-fill-column-in-modes' variable to +-;; setup the list of modes in which to highlight-beyond-fill-column ++;; Enable it on a buffer using `M-x highlight-beyond-fill-column. ++;; You may use that command in a hook (e.g. text-mode-hook) + ;; +-;; Customize the `highlight-beyond-fill-column-face' variable to +-;; to setup the face used for highlight-beyond-fill-column ++;; Customize the `highlight-beyond-fill-column-face' variable to ++;; to setup the face used for highlight-beyond-fill-column + ;; + ;; Acknowledgement: + ;; + ;; This is based on initial code provided by Jim Janney (jjanney@xmission.com) +-;; ++ ++;;; History: ++;; ++;; V1.2 2003-09-12 by Peter S Galbraith ++;; - Made checkdoc clean and fixed indentation and parentheses placement. ++;; - Added defgroup; used defface. ++;; - Removed `highlight-beyond-fill-column-in-modes' since it didn't work ++;; anymore. ++;; - Created `highlight-beyond-fill-column' to use on a single buffer or as ++;; a hook. + + ;;; Code: +-(defcustom highlight-beyond-fill-column-in-modes nil +- "The list of modes in which to highlight-beyond-fill-column." +- :group 'fill +- :type '(repeat string) +- ) ++(defgroup highlight-beyond-fill-column nil ++ "Fontify beyond the fill-column." ++ :group 'fill) + +-(defcustom highlight-beyond-fill-column-face 'underline +- "The face to use with highlight-beyond-fill-column." +- :group 'fill +- :type 'face +- ) ++(defface highlight-beyond-fill-column-face ++ '((t (:underline t))) ++ "Face used to highlight beyond the fill-column." ++ :group 'highlight-current-line) + +-(defun find-after-fill-column (limit) +- "A function that can be used by `font-lock-add-keywords' to find columns that are +-beyond the `fill-column'." +- (let ( +- ; remember the point +- (original-point (point)) +- ) +- ; if already past the fill column start on next line ++(defun highlight-beyond-fill-column-lock (limit) ++ "Function for font-lock to highlight beyond the `fill-column' until LIMIT." ++ (let ((original-point (point))) ;; remember the point ++ ;; if already past the fill column start on next line + (if (> (current-column) fill-column) +- (forward-line 1) +- ) +- (while (and (< (point) limit) ; still within limit +- (or (< (move-to-column fill-column) fill-column) ; the line has less than `fill-column' columns +- (= (point) (line-end-position)) ; end of line +- ) +- ) +- ; goto next line +- (forward-line 1) +- ) ++ (forward-line 1)) ++ (while (and (< (point) limit) ; still within limit ++ ;; the line has less than `fill-column' columns ++ (or (< (move-to-column fill-column) fill-column) ++ (= (point) (line-end-position)))) ; end of line ++ ;; goto next line ++ (forward-line 1)) + +- (if (>= (point) limit) ; beyond limit +- (progn +- (goto-char original-point) ; restore point +- nil ; return nil +- ) +- (set-match-data (list (point-marker) ; set match data +- (progn +- (end-of-line) +- (forward-char) ; this gives the highlight till the end of the window +- (point-marker) +- ) +- ) +- ) +- t) ; return t indicating that the match data was set +- ) +- ) ++ (if (>= (point) limit) ; beyond limit ++ (progn ++ (goto-char original-point) ; restore point ++ nil) ; return nil + +-(defun init-highlight-beyond-fill-column () +- "" +- (let ( +- (modelist highlight-beyond-fill-column-in-modes) +- mode +- ) +- (while modelist +- (setq mode (intern (car modelist))) +- (if (and mode +- (functionp mode)) +- (font-lock-add-keywords mode +- '( +- (find-after-fill-column 0 highlight-beyond-fill-column-face prepend) +- ) +- ) +- ) +- (setq modelist (cdr modelist)) +- ) +- ) +- ) ++ (set-match-data (list (point-marker) ; set match data ++ (progn ++ (end-of-line) ++ (point-marker)))) ++ ;; return t indicating that the match data was set ++ t))) + +-(add-hook 'after-init-hook 'init-highlight-beyond-fill-column) ++;;;###autoload ++(defun highlight-beyond-fill-column () ++ "Setup this buffer to highlight beyond the `fill-column'." ++ (interactive) ++ (font-lock-add-keywords ++ nil ++ '((highlight-beyond-fill-column-lock 0 'highlight-beyond-fill-column-face ++ prepend)))) + + (provide 'highlight-beyond-fill-column) ++ ++;;; highlight-beyond-fill-column.el ends here diff --git a/debian/patches/50_joc-toggle-buffer.diff b/debian/patches/50_joc-toggle-buffer.diff new file mode 100644 index 0000000..e4df0b1 --- /dev/null +++ b/debian/patches/50_joc-toggle-buffer.diff @@ -0,0 +1,75 @@ +## 50_joc-toggle-buffer.diff by Peter S Galbraith + +--- a/elisp/emacs-goodies-el/joc-toggle-buffer.el 2004-04-20 14:44:06.000000000 -0400 ++++ b/elisp/emacs-goodies-el/joc-toggle-buffer.el 2004-04-20 14:46:48.000000000 -0400 +@@ -1,4 +1,4 @@ +-;;; @(#) toggle-buffer.el --- flips back and forth between two buffers ++;;; @(#) joc-toggle-buffer.el --- flips back and forth between two buffers + + ;; Copyright (C) 2001 by Joseph L. Casadonte Jr. + +@@ -62,7 +62,7 @@ + ;; Put this file on your Emacs-Lisp load path and add the following to your + ;; ~/.emacs startup file + ;; +-;; (require 'toggle-buffer) ++;; (require 'joc-toggle-buffer) + + ;;; Usage: + ;; +@@ -99,13 +99,18 @@ + ;; Any comments, suggestions, bug reports or upgrade requests are welcome. + ;; Please send them to Joe Casadonte (emacs@northbound-train.com). + ;; +-;; This version of toggle-buffer was developed and tested with NTEmacs 20.5.1 ++;; This version of joc-toggle-buffer was developed and tested with NTEmacs 20.5.1 + ;; and 2.7 under Windows NT 4.0 SP6 and Emacs 20.7.1 under Linux (RH7). + ;; Please, let me know if it works with other OS and versions of Emacs. + + ;;; Change Log: + ;; + ;; see http://www.northbound-train.com/emacs/toggle-buffer.log ++;; ++;; 2003-11-23 Peter S Galbraith ++;; This version, distributed in the Debian package `emacs-goodies-el', ++;; was renamed from toggle-buffer.el to joc-toggle-buffer.el. The prefix ++;; was also added to a few variables. + + ;;; ************************************************************************** + ;;; ************************************************************************** +@@ -151,7 +156,7 @@ + :group 'joc-toggle-buffer) + + ;; --------------------------------------------------------------------------- +-(defcustom toggle-buffer-load-hook nil ++(defcustom joc-toggle-buffer-load-hook nil + "Hook to run when package is loaded." + :type 'hook + :group 'joc-toggle-buffer) +@@ -181,10 +186,12 @@ + (defvar joc-toggle-buffer-last-buffer nil + "Contains the name of the previous buffer.") + ++;;;###autoload + (defun joc-toggle-buffer () + "Switch to previous active buffer." + (interactive) +- (if (not (boundp 'joc-toggle-buffer-last-buffer)) ++ (if (or (not (boundp 'joc-toggle-buffer-last-buffer)) ++ (not joc-toggle-buffer-last-buffer)) + (error "No previous buffer to switch to (yet)")) + (let ((buff (get-buffer joc-toggle-buffer-last-buffer))) + (if (not buff) +@@ -231,9 +238,8 @@ + ;;; ************************************************************************** + ;;; ***** we're done + ;;; ************************************************************************** +-(provide 'toggle-buffer) +-(run-hooks 'toggle-buffer-load-hook) ++(run-hooks 'joc-toggle-buffer-load-hook) ++ ++(provide 'joc-toggle-buffer) + + ;;; toggle-buffer.el ends here +-;;; ************************************************************************** +-;;;; ***** EOF ***** EOF ***** EOF ***** EOF ***** EOF ************* diff --git a/debian/patches/50_joc-toggle-case.diff b/debian/patches/50_joc-toggle-case.diff new file mode 100644 index 0000000..2c4a152 --- /dev/null +++ b/debian/patches/50_joc-toggle-case.diff @@ -0,0 +1,181 @@ +## 50_joc-toggle-case.diff by Peter S Galbraith + +--- a/elisp/emacs-goodies-el/joc-toggle-case.el ++++ b/elisp/emacs-goodies-el/joc-toggle-case.el +@@ -28,7 +28,9 @@ + ;; Boston, MA 02111-1307, USA. + ;;; ************************************************************************** + +-;;; Description: ++;;; Commentary: ++;; ++;; Description: + ;; + ;; This packages provides a sophisticated (over-engineered?) set of + ;; functions to toggle the case of the character under point, with +@@ -38,16 +40,16 @@ + ;; character, allowing successive invocations to progress down the + ;; line. + +-;;; Installation: ++;; Installation: + ;; + ;; Put this file on your Emacs-Lisp load path and add the following to your + ;; ~/.emacs startup file + ;; +-;; (require 'toggle-case) ++;; (require 'joc-toggle-case) + ;; + ;; See below for key-binding suggestions. + +-;;; Usage: ++;; Usage: + ;; + ;; M-x `joc-toggle-case' + ;; Toggles the case of the character under point. If called with +@@ -81,7 +83,7 @@ + ;; M-x `joc-toggle-case-by-word-backwards' + ;; Toggles the case of all characters in the current region. + +-;;; Customization: ++;; Customization: + ;; + ;; M-x `joc-toggle-case-customize' to customize all package options. + ;; +@@ -95,7 +97,7 @@ + ;; is reversed, the semantics of this are reveresed as well + ;; (i.e. does it stop at the beginning of the line). + +-;;; Keybinding examples: ++;; Keybinding examples: + ;; + ;; This is what I have -- use it or not as you like. + ;; +@@ -119,7 +121,7 @@ + ;; Any comments, suggestions, bug reports or upgrade requests are welcome. + ;; Please send them to Joe Casadonte (emacs@northbound-train.com). + ;; +-;; This version of toggle-case was developed and tested with NTEmacs ++;; This version of joc-toggle-case was developed and tested with NTEmacs + ;; 2.7 under Windows NT 4.0 SP6 and Emacs 20.7.1 under Linux (RH7). + ;; Please, let me know if it works with other OS and versions of Emacs. + +@@ -128,6 +130,14 @@ + ;;; ************************************************************************** + ;;; ************************************************************************** + ;;; ************************************************************************** ++ ++;;; History: ++;; ++;; 2003-11-23 Peter S Galbraith ++;; This version, distributed in the Debian package `emacs-goodies-el', ++;; was renamed from toggle-case.el to joc-toggle-case.el. The prefix ++;; was also added in the file where appropriate. ++ + ;;; Code: + + ;;; ************************************************************************** +@@ -139,7 +149,7 @@ + + ;; --------------------------------------------------------------------------- + (defun joc-toggle-case-customize () +- "Customization of the group joc-toggle-case." ++ "Customization of the group `joc-toggle-case'." + (interactive) + (customize-group "joc-toggle-case")) + +@@ -150,7 +160,7 @@ + stop at the end of the line, set to `nil' it will not (it + will continue on to the next line). If direction of toggle + is reversed, the semantics of this are reveresed as well +-(i.e. does it stop at the beginning of the line)." ++\(i.e. does it stop at the beginning of the line)." + :group 'joc-toggle-case + :type 'boolean) + +@@ -163,26 +173,27 @@ + + ;; --------------------------------------------------------------------------- + (defun joc-toggle-case-version-number () +- "Returns joc-toggle-case version number." ++ "Return `joc-toggle-case' version number." + (string-match "[0123456789.]+" joc-toggle-case-version) + (match-string 0 joc-toggle-case-version)) + + ;; --------------------------------------------------------------------------- + (defun joc-toggle-case-display-version () +- "Displays joc-toggle-case version." ++ "Displays `joc-toggle-case' version." + (interactive) + (message "joc-toggle-case version <%s>." (joc-toggle-case-version-number))) + + ;;; ************************************************************************** + ;;; ***** interactive functions + ;;; ************************************************************************** ++;;;###autoload + (defun joc-toggle-case (prefix) +- "Toggles the case of the character under point. If called with +-a prefix argument, it toggles that many characters (see +-joc-toggle-case-stop-at-eol). If the prefix is negative, the +-case of the character before point is toggled, and if called +-with a prefix argument, N characters before point will have +-their case toggled (see also joc-toggle-case-backwards)." ++ "Toggle the case of the character under point. ++If called with a PREFIX argument, it toggles that many ++characters (see joc-toggle-case-stop-at-eol). If the prefix is ++negative, the case of the character before point is toggled, and ++if called with a prefix argument, N characters before point will ++have their case toggled (see also joc-toggle-case-backwards)." + + (interactive "*p") + +@@ -207,14 +218,16 @@ + (setq lcv count))))) + + ;; --------------------------------------------------------------------------- ++;;;###autoload + (defun joc-toggle-case-backwards (prefix) +- "Convenience function to toggle case of character preceeding +-point. This is the same as calling joc-toggle-case with a +-negative prefix (and is in fact implemented that way)." ++ "Convenience function to toggle case of character preceeding point. ++This is the same as calling joc-toggle-case with a negative ++prefix (and is in fact implemented that way)." + (interactive "*p") + (joc-toggle-case (- prefix))) + + ;; --------------------------------------------------------------------------- ++;;;###autoload + (defun joc-toggle-case-by-word (prefix) + "Similar to joc-toggle-case except that the count (supplied by + the prefix argument) is of the number of words, not letters, to +@@ -238,14 +251,16 @@ + (joc-toggle-case (- end start)))) + + ;; --------------------------------------------------------------------------- ++;;;###autoload + (defun joc-toggle-case-by-word-backwards (prefix) +- "Convenience function to toggle case by word, backwards. This +-is the same as calling joc-toggle-case-by-word with a ++ "Convenience function to toggle case by word, backwards. ++This is the same as calling joc-toggle-case-by-word with a + negative prefix (and is in fact implemented that way)." + (interactive "*p") + (joc-toggle-case-by-word (- prefix))) + + ;; --------------------------------------------------------------------------- ++;;;###autoload + (defun joc-toggle-case-by-region (start end) + "Toggles the case of all characters in the current region." + (interactive "*r") +@@ -310,8 +325,6 @@ + ;;; ************************************************************************** + ;;; ***** we're done + ;;; ************************************************************************** +-(provide 'toggle-case) ++(provide 'joc-toggle-case) + +-;; toggle-case.el ends here! +-;;; ************************************************************************** +-;;;; ***** EOF ***** EOF ***** EOF ***** EOF ***** EOF ************* ++;;; joc-toggle-case.el ends here diff --git a/debian/patches/50_maplevtexi.diff b/debian/patches/50_maplevtexi.diff new file mode 100755 index 0000000..66b53f7 --- /dev/null +++ b/debian/patches/50_maplevtexi.diff @@ -0,0 +1,45 @@ +#! /bin/sh /usr/share/dpatch/dpatch-run +## 50_maplevtexi.diff.dpatch by +## +## All lines beginning with `## DP:' are a description of the patch. +## DP: No description. + +@DPATCH@ +diff -urNad '--exclude=CVS' '--exclude=.svn' '--exclude=.git' '--exclude=.arch' '--exclude=.hg' '--exclude=_darcs' '--exclude=.bzr' emacs-goodies-el~/elisp/emacs-goodies-el/maplev.texi emacs-goodies-el/elisp/emacs-goodies-el/maplev.texi +--- emacs-goodies-el~/elisp/emacs-goodies-el/maplev.texi 2014-07-08 15:53:02.000000000 -0400 ++++ emacs-goodies-el/elisp/emacs-goodies-el/maplev.texi 2014-07-08 16:00:11.050362706 -0400 +@@ -1,10 +1,10 @@ + \input texinfo + ++@set VERSION 2.27 ++@set DATE June 2011 + @setfilename maplev + @settitle MapleV Emacs Mode @value{VERSION} + +-@set VERSION 2.27 +-@set DATE June 2011 + + @dircategory Emacs + @direntry +@@ -12,7 +12,11 @@ + @end direntry + + +-@include version.texi ++@set UPDATED 2 January 2010 ++@c Edition of the Manual ++@set EDITION 1.1 ++@c Version of the Code ++@set VERSION 2.16 + + @iftex + @tolerance 10000 +@@ -225,7 +229,7 @@ + + @node GNU Free Documentation License, Introduction, Copying, top + @unnumbered GNU Free Documentation License +-@include fdl.texi ++@c @include fdl.texi + + + diff --git a/debian/patches/50_marker-visit_autoloads.diff b/debian/patches/50_marker-visit_autoloads.diff new file mode 100644 index 0000000..b222207 --- /dev/null +++ b/debian/patches/50_marker-visit_autoloads.diff @@ -0,0 +1,28 @@ +## 50_marker-visit_autoloads.diff by Peter S Galbraith + +--- a/elisp/emacs-goodies-el/marker-visit.el 2001-05-22 02:13:48.000000000 -0400 ++++ b/elisp/emacs-goodies-el/marker-visit.el 2003-11-16 21:30:42.000000000 -0500 +@@ -87,6 +87,7 @@ + (message error-message) + (beep)) + ++;;;###autoload + (defun marker-visit-prev () + "From point, visit the nearest mark earlier in the buffer." + (interactive) +@@ -102,6 +103,7 @@ + (goto-char dest-mark) + (marker-visit-warn "No previous mark to visit"))))) + ++;;;###autoload + (defun marker-visit-next () + "From point, visit the nearest mark later in the buffer." + (interactive) +@@ -121,6 +123,7 @@ + (goto-char dest-mark) + (marker-visit-warn "No next mark to visit"))))) + ++;;;###autoload + (defun marker-visit-truncate-mark-ring () + "Truncate the `mark-ring'." + (interactive) diff --git a/debian/patches/50_minibuf-electric.diff b/debian/patches/50_minibuf-electric.diff new file mode 100644 index 0000000..0bfa4a2 --- /dev/null +++ b/debian/patches/50_minibuf-electric.diff @@ -0,0 +1,23 @@ +Index: emacs-goodies-el-35.12ubuntu1/elisp/emacs-goodies-el/minibuf-electric.el +=================================================================== +--- emacs-goodies-el-35.12ubuntu1.orig/elisp/emacs-goodies-el/minibuf-electric.el ++++ emacs-goodies-el-35.12ubuntu1/elisp/emacs-goodies-el/minibuf-electric.el +@@ -46,12 +46,17 @@ in `substitute-in-file-name'." + :require 'minibuf-electric + :group 'minibuffer) + ++;;; HACK ++(defvar directory-sep-char ?/) ++ + ;;; originally by Stig@hackvan.com, taken from XEmacs 21.4 + ;;; + (defun minibuffer-electric-separator () + "Insert / separator, but clear line first if typed twice in a row." + (interactive) +- (let ((c last-command-char)) ++ (let ((c (if (not (>= emacs-major-version 24)) ++ last-command-char ++ last-command-event))) + (and minibuffer-completing-file-name ; added for GNU Emacs + minibuffer-electric-file-name-behavior + (eq c directory-sep-char) diff --git a/debian/patches/50_protbuf_custom_and_toggle.diff b/debian/patches/50_protbuf_custom_and_toggle.diff new file mode 100644 index 0000000..7bf2a10 --- /dev/null +++ b/debian/patches/50_protbuf_custom_and_toggle.diff @@ -0,0 +1,161 @@ +## 50_protbuf_custom_and_toggle.diff by Peter S Galbraith + +--- a/elisp/emacs-goodies-el/protbuf.el 2003-10-07 19:18:26.000000000 -0400 ++++ b/elisp/emacs-goodies-el/protbuf.el 2003-10-07 21:20:08.000000000 -0400 +@@ -29,24 +29,49 @@ + + ;; This package allows you to make it harder to kill buffers accidentally, + ;; e.g. by being too trigger happy selecting items in the buffer menu. +-;; protect-process-buffer-from-kill-mode is perhaps the more useful of the +-;; two, making it harder to accidentally kill shell buffers without ++;; ++;; The commands are: ++;; ++;; `protect-buffer-from-kill-mode' ++;; Toggle kill-buffer protection on current buffer. ++;; ++;; `protect-process-buffer-from-kill-mode' ++;; Toggle kill-buffer protection on current buffer with active process. ++;; Protection only applies as long as the buffer has an active process. ++;; ++;; `protect-process-buffer-from-kill-mode' is perhaps the more useful of ++;; the two, making it harder to accidentally kill shell buffers without + ;; terminating the process in them first. + ++;;; History: ++;; ++;; 2003-10-07 Peter S Galbraith ++;; - custom interface support. ++;; - make interactive commands toggle the minor-mode. ++;; - some checkdoc changes. ++ + ;;; Code: + +-(defvar protect-buffer-verbose t +- "*If non-nil, print a message when attempting to kill a protected buffer.") ++(defgroup protect-buffer nil ++ "Protect buffers from accidental killing." ++ :group 'killing) + +-(defvar protect-buffer-bury-p t ++(defcustom protect-buffer-verbose t ++ "*If non-nil, print a message when attempting to kill a protected buffer." ++ :type 'boolean ++ :group 'protect-buffer) ++ ++(defcustom protect-buffer-bury-p t + "*If non-nil, bury buffer when attempting to kill it. + This only has an effect if the buffer to be killed is the one +-visible in the selected window.") ++visible in the selected window." ++ :type 'boolean ++ :group 'protect-buffer) + + + ;;;###autoload + (defvar protect-buffer-from-kill-mode nil +- "*If non-`nil', then prevent buffer from being accidentally killed. ++ "*If non-nil, then prevent buffer from being accidentally killed. + This variable is local to all buffers.") + (progn + (make-variable-buffer-local 'protect-buffer-from-kill-mode) +@@ -57,7 +82,7 @@ + + ;;;###autoload + (defvar protect-process-buffer-from-kill-mode nil +- "*If non-`nil', then protect buffer with live process from being killed. ++ "*If non-nil, then protect buffer with live process from being killed. + This variable is local to all buffers.") + (progn + (make-variable-buffer-local 'protect-process-buffer-from-kill-mode) +@@ -84,32 +109,26 @@ + + ;;;###autoload + (defun protect-buffer-from-kill-mode (&optional prefix buffer) +- "Protect buffer from being killed. +-To remove this protection, call this command with a negative prefix argument." ++ "Toggle `kill-buffer' protection on current buffer. ++Optionally, set a PREFIX argument to set or unset protection, and specify ++alternate BUFFER." + (interactive "P") +- (or buffer (setq buffer (current-buffer))) + (save-excursion +- ;; Each cond does its own set-buffer *after* comparing prefix just in +- ;; case there's a buffer-local variable `prefix' to screw up the works. +- (cond +- ((null prefix) +- (set-buffer buffer) +- (setq protect-buffer-from-kill-mode +- (not protect-buffer-from-kill-mode))) +- ((>= prefix 0) +- (set-buffer buffer) +- (setq protect-buffer-from-kill-mode t)) +- (t +- (set-buffer buffer) +- (setq protect-buffer-from-kill-mode nil))) ++ (if buffer ++ (set-buffer buffer)) ++ (set (make-local-variable 'protect-buffer-from-kill-mode) ++ (if prefix ++ (> (prefix-numeric-value prefix) 0) ++ (not protect-buffer-from-kill-mode))) + ;; This is always done because kill-buffer-query-functions might have + ;; been buffer-local when this package was initially loaded, leaving + ;; the global value unchanged. + (add-hook 'kill-buffer-query-functions 'protect-buffer-from-kill))) + +-;; This function is listed in kill-buffer-query-functions; it should return +-;; nil if the buffer should not be killed, t otherwise. + (defun protect-buffer-from-kill () ++ "Implements protection from buffer killing. ++This function is listed in `kill-buffer-query-functions'; it should return ++nil if the buffer should not be killed, t otherwise." + (cond + (protect-buffer-from-kill-mode + (and protect-buffer-verbose +@@ -125,32 +144,27 @@ + + ;;;###autoload + (defun protect-process-buffer-from-kill-mode (&optional prefix buffer) +- "Protect buffer from being killed as long as it has an active process. +-To remove this protection, call this command with a negative prefix argument." ++ "Toggle `kill-buffer' protection on current buffer with active process. ++Protection only applies as long as the buffer has an active process. ++Optionally, set a PREFIX argument to set or unset protection, and specify ++alternate BUFFER." + (interactive "P") +- (or buffer (setq buffer (current-buffer))) + (save-excursion +- ;; Each cond does its own set-buffer *after* comparing prefix just in +- ;; case there's a buffer-local variable `prefix' to screw up the works. +- (cond +- ((null prefix) +- (set-buffer buffer) +- (setq protect-process-buffer-from-kill-mode +- (not protect-process-buffer-from-kill-mode))) +- ((>= prefix 0) +- (set-buffer buffer) +- (setq protect-process-buffer-from-kill-mode t)) +- (t +- (set-buffer buffer) +- (setq protect-process-buffer-from-kill-mode nil))) ++ (if buffer ++ (set-buffer buffer)) ++ (set (make-local-variable 'protect-process-buffer-from-kill-mode) ++ (if prefix ++ (> (prefix-numeric-value prefix) 0) ++ (not protect-process-buffer-from-kill-mode))) + ;; This is always done because kill-buffer-query-functions might have + ;; been buffer-local when this package was initially loaded, leaving + ;; the global value unchanged. + (add-hook 'kill-buffer-query-functions 'protect-process-buffer-from-kill))) + +-;; This function is listed in kill-buffer-query-functions; it should return +-;; nil if the buffer should be protected, t if buffer should be killed. + (defun protect-process-buffer-from-kill () ++ "Implements protection from buffer killing. ++This function is listed in `kill-buffer-query-functions'; it should return ++nil if the buffer should be protected, t if buffer should be killed." + (cond + ((not protect-process-buffer-from-kill-mode) t) + ((or (and (boundp 'protect-process-buffer-from-kill-preserve-function) diff --git a/debian/patches/50_quack_autoload.diff b/debian/patches/50_quack_autoload.diff new file mode 100644 index 0000000..9914bd2 --- /dev/null +++ b/debian/patches/50_quack_autoload.diff @@ -0,0 +1,100 @@ +## 50_quack_autoload.diff by Daniel Moerner + +--- a/elisp/emacs-goodies-el/quack.el ++++ b/elisp/emacs-goodies-el/quack.el +@@ -62,9 +62,10 @@ + ;; INSTALLATION: + ;; + ;; To install, put this file (`quack.el') somewhere in your Emacs load +-;; path, and add the following line to your `.emacs' file: ++;; path, and add the following lines to your `.emacs' file: + ;; + ;; (require 'quack) ++;; (quack-install) + ;; + ;; If you don't know what your Emacs load path is, try invoking the command + ;; "C-h v load-path RET" or consulting the Emacs manual. +@@ -3159,6 +3160,8 @@ + ;; Non-Scheme: + ("\\.plt\\'" . quack-pltfile-mode))) + ++;;;###autoload(add-to-list 'auto-mode-alist '("\\.plt\\'" . quack-pltfile-mode)) ++ + ;; Syntax Table: + + (defmacro quack-str-syntax (str) +@@ -3508,10 +3511,6 @@ + (add-submenu nil quack-global-menuspec "Help" current-menubar) + (set-menubar-dirty-flag)))) + +-;; TODO: We should make sure the user's custom settings have been loaded +-;; before we do this. +-(quack-install-global-menu) +- + ;; And die some more! + ;;(quack-when-xemacs (add-hook 'after-init-hook 'quack-install-global-menu)) + +@@ -4132,9 +4131,11 @@ + (quack-when-xemacs + (quack-install-global-menu))) + ++;;;###autoload + (defun quack-inferior-scheme-mode-hookfunc () + (quack-shared-mode-hookfunc-stuff)) + ++;;;###autoload + (defun quack-scheme-mode-hookfunc () + (quack-shared-mode-hookfunc-stuff) + +@@ -4147,9 +4148,6 @@ + ;;(quack-install-tool-bar))) + ) + +-(add-hook 'scheme-mode-hook 'quack-scheme-mode-hookfunc) +-(add-hook 'inferior-scheme-mode-hook 'quack-inferior-scheme-mode-hookfunc) +- + ;; Compilation Mode: + + ;; TODO: Add compilation-directory-matcher support for "setup-plt: in". +@@ -4215,8 +4213,6 @@ + (append quack-compilation-error-regexp-alist-additions + quack-saved-compilation-error-regexp-alist))) + +-(quack-install-compilation-mode-stuff) +- + ;; Interpreter-mode-alist: + + (defvar quack-saved-interpreter-mode-alist nil) +@@ -4256,8 +4252,6 @@ + (append quack-interpreter-mode-alist-additions + quack-saved-interpreter-mode-alist))) + +-(quack-install-interpreter-mode-alist) +- + ;; PLT Package Mode: + + ;; TODO: Do some simple checking and summarize what directories and files are +@@ -4285,6 +4279,7 @@ + + ;; TODO: Make a menu map for pltfile-mode. + ++;;;###autoload + (defun quack-pltfile-mode () + (interactive) + "Major mode for viewing PLT Scheme `.plt' package files. +@@ -4812,6 +4807,15 @@ + + ;; End: + ++;;;###autoload ++(defun quack-install () ++ "Install quack.el into scheme-mode." ++ (add-hook 'scheme-mode-hook 'quack-scheme-mode-hookfunc) ++ (add-hook 'inferior-scheme-mode-hook 'quack-inferior-scheme-mode-hookfunc) ++ (quack-install-compilation-mode-stuff) ++ (quack-install-interpreter-mode-alist) ++ (quack-install-global-menu)) ++ + (provide 'quack) + + ;; quack.el ends here diff --git a/debian/patches/50_rfcview.diff b/debian/patches/50_rfcview.diff new file mode 100644 index 0000000..897d407 --- /dev/null +++ b/debian/patches/50_rfcview.diff @@ -0,0 +1,11 @@ +--- a/elisp/emacs-goodies-el/rfcview.el ++++ b/elisp/emacs-goodies-el/rfcview.el +@@ -376,7 +376,7 @@ + (if (= n 0) "?" (1+ n)))))) + (overlay-put overlay + 'before-string +- (concat (make-string (max (- 79 ++ (concat (make-string (max (- fill-column + (- (match-beginning 1) + (match-beginning 0)) + (length page-str)) diff --git a/debian/patches/50_session_enable_custom.diff b/debian/patches/50_session_enable_custom.diff new file mode 100644 index 0000000..74658e0 --- /dev/null +++ b/debian/patches/50_session_enable_custom.diff @@ -0,0 +1,18 @@ +## 50_session_enable_custom.diff by Peter S Galbraith + +--- a/elisp/emacs-goodies-el/session.el ++++ b/elisp/emacs-goodies-el/session.el +@@ -244,7 +244,12 @@ + (const :tag "Load/Save Session" session) + (const :tag "Store/Use Places" places) + (const :tag "Setup Key/Mouse Bindings" keys) +- (const :tag "Setup Menus" menus)))) ++ (const :tag "Setup Menus" menus))) ++ :require 'session ++ :set (lambda (symbol value) ++ (set-default symbol value) ++ (when value ++ (add-hook 'after-init-hook 'session-initialize)))) + + + ;;;=========================================================================== diff --git a/debian/patches/50_setnu.diff b/debian/patches/50_setnu.diff new file mode 100644 index 0000000..cb34905 --- /dev/null +++ b/debian/patches/50_setnu.diff @@ -0,0 +1,229 @@ +## 50_setnu.diff by Peter S Galbraith + +--- a/elisp/emacs-goodies-el/setnu.el 2003-10-15 20:54:31.000000000 -0400 ++++ b/elisp/emacs-goodies-el/setnu.el 2003-10-14 21:37:45.000000000 -0400 +@@ -1,32 +1,42 @@ +-;;; vi-style line number mode for Emacs +-;;; (requires Emacs 19.29 or later, or XEmacs 19.14 or later) +-;;; Copyright (C) 1994, 1995, 1997 Kyle E. Jones +-;;; +-;;; This program is free software; you can redistribute it and/or modify +-;;; it under the terms of the GNU General Public License as published by +-;;; the Free Software Foundation; either version 2, or (at your option) +-;;; any later version. +-;;; +-;;; This program is distributed in the hope that it will be useful, +-;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-;;; GNU General Public License for more details. +-;;; +-;;; A copy of the GNU General Public License can be obtained from this +-;;; program's author (send electronic mail to kyle@uunet.uu.net) or from +-;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA +-;;; 02139, USA. +-;;; +-;;; Send bug reports to kyle@wonderworks.com ++;;; setnu.el --- vi-style line number mode for Emacs ++;; ++;; (requires Emacs 19.29 or later, or XEmacs 19.14 or later) ++;; Copyright (C) 1994, 1995, 1997 Kyle E. Jones ++;; ++;; This program is free software; you can redistribute it and/or modify ++;; it under the terms of the GNU General Public License as published by ++;; the Free Software Foundation; either version 2, or (at your option) ++;; any later version. ++;; ++;; This program is distributed in the hope that it will be useful, ++;; but WITHOUT ANY WARRANTY; without even the implied warranty of ++;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ++;; GNU General Public License for more details. ++;; ++;; A copy of the GNU General Public License can be obtained from this ++;; program's author (send electronic mail to kyle@uunet.uu.net) or from ++;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA ++;; 02139, USA. ++ ++;;; Commentary: ++;; ++;; Send bug reports to kyle@wonderworks.com + ;; + ;; M-x setnu-mode toggles the line number mode on and off. + ;; +-;; turn-on-setnu-mode is useful for adding to a major-mode hook +-;; variable. ++;; turn-on-setnu-mode is useful for adding to a major-mode hook variable. + ;; Example: + ;; (add-hook 'text-mode-hook 'turn-on-setnu-mode) +-;; to automatically turn on line numbering when enterting text-mode." ++;; to automatically turn on line numbering when enterting text-mode." + ++;;; History: ++;; ++;; 2003-10-13 Peter S Galbraith ++;; - made checkdoc changes (but it's still not happy). ++;; - created settnu defgroup and created defface setnu-line-number-face. ++;; - added atoload tags. ++ ++;;; Code: + (provide 'setnu) + + (defconst setnu-running-under-xemacs +@@ -34,20 +44,20 @@ + (string-match "Lucid" emacs-version))) + + (defconst setnu-mode-version "1.06" +- "Version number for this release of setnu-mode.") ++ "Version number for this release of `setnu-mode'.") + + (defvar setnu-mode nil +- "Non-nil if setnu-mode is active in the current buffer.") ++ "Non-nil if `setnu-mode' is active in the current buffer.") + (make-variable-buffer-local 'setnu-mode) + + (defvar setnu-start-extent nil +- "First extent of a chain of extents used by setnu-mode. ++ "First extent of a chain of extents used by `setnu-mode'. + Each line has its own extent. Each line extent has a + `setnu-next-extent' property that points to the next extent in + the chain, which is the extent for the next line in the buffer. + There is also a `setnu-prev-extent' that points at the previous + extent in the chain. To distinguish them from other extents the +-setnu-mode extents all have a non-nil `setnu' property.") ++`setnu-mode' extents all have a non-nil `setnu' property.") + (make-variable-buffer-local 'setnu-start-extent) + + (defvar setnu-glyph-obarray (make-vector 401 0) +@@ -66,14 +76,21 @@ + `format' will be called with this string and one other argument + which will be an integer, the line number.") + +-(defvar setnu-line-number-face 'bold +- "*Face used to display the line numbers. +-Currently this works for XEmacs 19.12 and later versions only.") ++(defvar setnu-line-number-face 'setnu-line-number-face ++ "*Face used to display the line numbers.") ++ ++(defgroup setnu nil ++ "vi-style line number mode for Emacs.") ++ ++(defface setnu-line-number-face '((t (:bold t))) ++ "*Face used to display the line numbers." ++ :group 'setnu) + ++;;;###autoload + (defun setnu-mode (&optional arg) +- "Toggle setnu-mode. +-With prefix argument, turn setnu-mode on if argument is positive. +-When setnu-mode is enabled, a line number will appear at the left ++ "Toggle `setnu-mode'. ++With prefix argument ARG, turn `setnu-mode' on if argument is positive. ++When `setnu-mode' is enabled, a line number will appear at the left + margin of each line." + (interactive "P") + (let ((oldmode (not (not setnu-mode))) +@@ -85,12 +102,13 @@ + (setnu-mode-on) + (setnu-mode-off))))) + ++;;;###autoload + (defun turn-on-setnu-mode () +- "Turn on setnu-mode. +-Useful for adding to a major-mode hook variable. ++ "Turn on `setnu-mode'. ++Useful for adding to a `major-mode' hook variable. + Example: + (add-hook 'text-mode-hook 'turn-on-setnu-mode) +-to automatically turn on line numbering when enterting text-mode." ++to automatically turn on line numbering when enterting `text-mode'." + (setnu-mode 1)) + + ;;; Internal functions +@@ -148,8 +166,8 @@ + (put-text-property 0 (length g) 'face face g)))) + + (defun setnu-mode-off () +- "Internal shutdown of setnu-mode. +-Deletes the extents associated with setnu-mode." ++ "Internal shutdown of `setnu-mode'. ++Deletes the extents associated with `setnu-mode'." + (if (and setnu-running-under-xemacs + (fboundp 'remove-specifier)) + (remove-specifier left-margin-width (current-buffer))) +@@ -163,11 +181,13 @@ + (setq setnu-start-extent nil)))) + + (defun setnu-mode-on () +- "Internal startup of setnu-mode. +-Sets up the extents associated with setnu-mode." ++ "Internal startup of `setnu-mode'. ++Sets up the extents associated with `setnu-mode'." + (if (and setnu-running-under-xemacs + (fboundp 'set-specifier)) + (set-specifier left-margin-width 6 (current-buffer))) ++ (add-hook 'before-change-functions 'setnu-before-change-function) ++ (add-hook 'after-change-functions 'setnu-after-change-function) + (let ((done nil) + (curr-e nil) + (n 1) +@@ -196,9 +216,9 @@ + (store-match-data match-data)))) + + (defun setnu-before-change-function (start end) +- "Before change function for setnu-mode. ++ "Before change function for `setnu-mode'. + Notices when a delete is about to delete some lines and adjusts +-the line number extents accordingly." ++the line number extents accordingly (betwee START and END)." + (if (or (not setnu-mode) (= start end)) + () ;; not in setnu-mode or this is an insertion + (let ((inhibit-quit t) +@@ -252,9 +272,12 @@ + (store-match-data match-data))))) + + (defun setnu-after-change-function (start end length) +- "After change function for setnu-mode. ++ "After change function for `setnu-mode'. + Notices when an insert has added some lines and adjusts +-the line number extents accordingly." ++the line number extents accordingly. ++Three arguments are passed to an `after-change-function': the positions of ++the START and END of the range of changed text, ++and the LENGTH in bytes of the pre-change text replaced by that range." + (if (or (not setnu-mode) (= start end)) + () ; not in setnu-mode or this is a deletion + (let ((inhibit-quit t) +@@ -331,7 +354,8 @@ + g )))) + + (defun setnu-make-setnu-extent (beg end) +- "Create an extent and set some properties that all setnu extents have." ++ "Create an extent and set some properties that all setnu extents have. ++Extent is between BEG and END." + (let ((e (setnu-make-extent beg end))) + (setnu-set-extent-property e 'setnu t) + ;; (setnu-set-extent-property e 'begin-glyph-layout 'outside-margin) +@@ -389,11 +413,12 @@ + e + nil))) + buf pos pos))) +- (t (error "can't find overlays-in, overlays-at, or map-extents!"))) ++ (t (error "Can't find overlays-in, overlays-at, or map-extents!"))) + + (defun setnu-extent-at-create (pos buf) +- "Like `setnu-extent-at' except if an extent isn't found, then +-it is created based on where the extent failed to be found." ++ "Like `setnu-extent-at' for position POS in buffer BUF. ++If an extent isn't found, then it is created based on where the extent failed ++to be found." + (let ((e (setnu-extent-at pos buf)) ee beg numstr) + (if e + e +@@ -444,5 +469,6 @@ + (setnu-set-extent-begin-glyph e (setnu-number-glyph numstr)) + e )))))) + +-(add-hook 'before-change-functions 'setnu-before-change-function) +-(add-hook 'after-change-functions 'setnu-after-change-function) ++(provide 'setnu) ++ ++;;; setnu.el ends here diff --git a/debian/patches/50_silly-mail.diff b/debian/patches/50_silly-mail.diff new file mode 100644 index 0000000..3cb7f03 --- /dev/null +++ b/debian/patches/50_silly-mail.diff @@ -0,0 +1,1081 @@ +## 50_silly-mail.diff by Peter S Galbraith + +--- a/elisp/emacs-goodies-el/silly-mail.el 2003-04-04 15:16:10.000000000 -0500 ++++ b/elisp/emacs-goodies-el/silly-mail.el 2007-08-08 19:36:46.000000000 -0400 +@@ -28,42 +28,122 @@ + + ;;; Commentary: + +-;; To use this, put the following in your .emacs: ++;; To use this, invoke `M-x sm-add-random-header' from a mail composition ++;; buffer to insert a random header. You may call the command again to ++;; substitute the inserted header by another. ++;; ++;; Use 'M-x sm-delete-last-header' to remove it. ++;; ++;; If you wish all mail messages to have a randomly chosen header, put the ++;; following in your .emacs: + ;; + ;; (autoload 'sm-add-random-header "silly-mail" nil t) + ;; (add-hook 'mail-setup-hook 'sm-add-random-header) ++;; (add-hook 'mh-letter-mode-hook 'sm-add-random-header) ++;; ++;; or alternatively customize the variable `sm-add-ramdom-header-to-mail'. ++;; ++;; To setup menu-bar entries in sendmail and MH-E menus, customize the ++;; variable `sm-add-menu-bar-entries'. This has the disadvantage of ++;; loading this library at Emacs startup, so might not be a good choice if ++;; you rarely use silly-mail. ++;; ++;; You may customize silly-mail using `M-x customize-group [RET] silly-mail'. ++;; The following are customizable: ++;; ++;; - The list of header types used in the random selection by ++;; `sm-add-random-header' ++;; - Individual quotes may be disabled from the pool if some are offensive ++;; to you. ++;; - Whether all headers use an "X-" prefix or not. + + ;; I solicit more randomly generated headers commands. + + ;; Some of the options in this program require some external packages which +-;; are not a standard part of emacs, e.g. shop.el and flame.el (flame.el is ++;; are not a standard part of Emacs, e.g. shop.el and flame.el (flame.el is + ;; present in XEmacs and Emacs 18, but missing from Emacs 19). These are + ;; available from http://www.splode.com/users/friedman/software/emacs-lisp/ + ++;;; History: ++;; ++;; 2003-11-25 Peter S Galbraith ++;; ++;; - Added custom support. I had to change quote variables from vectors ++;; to lists to use the `set' custom type, but this had no impact on the ++;; code. I also had to change the format of the `sm-mail-header-table' ++;; variable (leading to a minor change in `sm-use-header-function-p'). ++;; The variable `sm-mail-header-table' is not generated when the variable ++;; `sm-mail-header-used' customization is set. ++;; - Made `sm-add-random-header' replace the inserted header if called a ++;; second time. ++;; - Added `sm-delete-last-header'. ++;; - Added optional "X-" prefix for those headers that didn't have them. ++;; - Added custom variables `sm-add-ramdom-header-to-mail' and ++;; `sm-add-menu-bar-entries' ++ + ;;; Code: + +-(require 'sendmail) ++;; Try without requiring sendmail, as byte-compilations fails if ++;; /usr/bin/mail doesn't exist (Closes: #434104) ++;; ++;;(require 'sendmail) ++ ++(defgroup silly-mail nil ++ "Generate bozotic mail headers." ++ :group 'mail ++ :group 'mh ++ :group 'sendmail) ++ ++(defcustom sm-add-ramdom-header-to-mail nil ++ "Setup sendmail and MH-E to call `sm-add-random-header' automatically." ++ :type 'boolean ++ :require 'silly-mail ++ :set (lambda (symbol value) ++ (set-default symbol value) ++ (cond ++ (value ++ (add-hook 'mail-setup-hook 'sm-add-random-header) ++ (add-hook 'mh-letter-mode-hook 'sm-add-random-header)) ++ (t ++ (remove-hook 'mail-setup-hook 'sm-add-random-header) ++ (remove-hook 'mh-letter-mode-hook 'sm-add-random-header)))) ++ :group 'silly-mail) ++ ++(defvar mail-mode-map) ++(defvar mh-letter-mode-map) ++(defcustom sm-add-menu-bar-entries nil ++ "Setup silly-mail menu-bar entries in MH-E and sendmail." ++ :type 'boolean ++ :require 'silly-mail ++ :set (lambda (symbol value) ++ (set-default symbol value) ++ (when value ++ (easy-menu-define sm-menu-map nil "silly-mail mh-letter menu" ++ '("Silly Mail" ++ ["Add Random Header" sm-add-random-header] ++ ["Delete Last Header" sm-delete-last-header])) ++ ++ (eval-after-load "sendmail" ++ '(easy-menu-add-item mail-mode-map '("menu-bar" "headers") ++ sm-menu-map)) ++ (eval-after-load "mh-comp" ++ '(easy-menu-add-item mh-letter-mode-map '("menu-bar" "Letter") ++ sm-menu-map)))) ++ :group 'silly-mail) ++ ++(defcustom sm-always-X-prefix nil ++ "Whether to use \"X-\" prefix in all silly-mail headers. ++This affects headers Emacs, Microsoft and Tomato." ++ :type 'boolean ++ :group 'silly-mail) + + (random t) + +-(defvar sm-mail-header-table +- '(sm-add-antipastobozoticataclysm +- (sm-add-at&t-hype youwill "youwill") +- sm-add-drdoom-fodder +- sm-add-emacs-name +- sm-add-emacs-taunt +- (sm-add-flame *flame "flame") +- (sm-add-horoscope horoscope "horoscope") +- (sm-add-kibology kibologize "kibologize") +- sm-add-meat +- sm-add-microsoft +- sm-add-nsa-fodder +- (sm-add-shopping-list shop-string "shop") +- sm-add-tom-swifty +- sm-add-tomato +- (sm-add-uboat-death-message uboat-death-message "uboat") +- sm-add-x-taunt +- sm-add-zippy-quote) ++(defvar sm-header-last-inserted nil ++ "Last header field inserted by silly-mail, such that it can be undone.") ++(make-variable-buffer-local 'sm-header-last-inserted) ++ ++(defvar sm-mail-header-table nil + "List of routines which generate silly mail headers. + Each element is either a symbol or a list. + If an element is a function, that function can be called. +@@ -72,25 +152,103 @@ + 2. A symbol naming a function required by the header-generator. + If this function is not defined, the header-generator cannot run. + 3. The name of a library to load if the required function isn't defined. +- If the load fails, or if `sm-load-missing-libraries' is `nil', +- the corresponding header-generator function won't be used.") ++ If the load fails, or if `sm-load-missing-libraries' is nil, ++ the corresponding header-generator function won't be used. + +-(defvar sm-load-missing-libraries t +- "*If non-`nil', load missing libraries for header functions. ++This variable is set via `sm-mail-header-used' customization.") ++ ++(defvar sm-mail-header-translation ++ '(("X-Antipastobozoticataclysm" sm-add-antipastobozoticataclysm) ++ ("X-AT&T-Hype" sm-add-at&t-hype youwill "youwill") ++ ("X-Drdoom-Fodder" sm-add-drdoom-fodder) ++ ("X-Emacs-Acronym" sm-add-emacs-name) ++ ("(X-)Emacs" sm-add-emacs-taunt) ++ ("X-Flame" sm-add-flame *flame "flame") ++ ("X-Horoscope" sm-add-horoscope horoscope "horoscope") ++ ("X-Kibo-Says" sm-add-kibology kibologize "kibologize") ++ ("X-Meat" sm-add-meat) ++ ("(X-)Microsoft" sm-add-microsoft) ++ ("X-NSA-Fodder" sm-add-nsa-fodder) ++ ("X-Shopping-List" sm-add-shopping-list shop-string "shop") ++ ("X-Tom-Swifty" sm-add-tom-swifty) ++ ("(X-)Tomato" sm-add-tomato) ++ ("X-Uboat-Death-Message" ++ sm-add-uboat-death-message uboat-death-message "uboat") ++ ("X-Windows" sm-add-x-taunt) ++ ("X-Zippy-Says" sm-add-zippy-quote))) ++ ++(defcustom sm-mail-header-used ++ '("X-Antipastobozoticataclysm" ++ "X-AT&T-Hype" ++ "X-Drdoom-Fodder" ++ "X-Emacs-Acronym" ++ "(X-)Emacs" ++ "X-Flame" ++ "X-Horoscope" ++ "X-Kibo-Says" ++ "X-Meat" ++ "(X-)Microsoft" ++ "X-NSA-Fodder" ++ "X-Shopping-List" ++ "X-Tom-Swifty" ++ "(X-)Tomato" ++ "X-Uboat-Death-Message" ++ "X-Windows" ++ "X-Zippy-Says") ++ "Header fields used ramdomly in silly-mail." ++ :type `(set ++ (const "X-Antipastobozoticataclysm") ++ (const "X-AT&T-Hype") ++ (const "X-Drdoom-Fodder") ++ (const "X-Emacs-Acronym") ++ (const "(X-)Emacs") ++ (const "X-Flame") ++ (const "X-Horoscope") ++ (const "X-Kibo-Says") ++ (const "X-Meat") ++ (const "(X-)Microsoft") ++ (const "X-NSA-Fodder") ++ (const "X-Shopping-List") ++ (const "X-Tom-Swifty") ++ (const "(X-)Tomato") ++ (const "X-Uboat-Death-Message") ++ (const "X-Windows") ++ (const "X-Zippy-Says")) ++ :set (lambda (symbol value) ++ (set-default symbol value) ++ (setq sm-mail-header-table nil) ++ (when value ++ (let ((the-list value)) ++ (while the-list ++ (let ((item (car the-list))) ++ (setq sm-mail-header-table ++ (append ++ sm-mail-header-table ++ (list (cdr (assoc item sm-mail-header-translation))))) ++ (setq the-list (cdr the-list))))))) ++ :group 'silly-mail) ++ ++(defcustom sm-load-missing-libraries nil ++ "*If non-nil, load missing libraries for header functions. + If nil, then if a library is not already loaded, the dependent +-header-generating function will not be used.") ++header-generating function will not be used." ++ :type 'boolean ++ :group 'silly-mail) + + ;;;###autoload + (defun sm-add-random-header () + "Insert a random silly mail header. +-The choice of available headers is taken from sm-mail-header-table." ++The choice of available headers is taken from `sm-mail-header-table'. ++If a random header was already inserted, it it removed in favor of a new one." + (interactive) ++ (if sm-header-last-inserted ++ (sm-delete-last-header)) + (funcall (sm-random-header-function))) + + ;;;###autoload + (defun sm-add-all-headers () + "Insert one of every kind of silly mail header defined. +-The choice of available headers is taken from sm-mail-header-table." ++The choice of available headers is taken from `sm-mail-header-table'." + (interactive) + (let ((fns sm-mail-header-table) + fn) +@@ -110,7 +268,7 @@ + + + (defun sm-use-header-function-p (func) +- (cond ((consp func) ++ (cond ((eq 3 (length func)) + (let ((fn (nth 0 func)) + (fbound-sym (nth 1 func)) + (lib (nth 2 func))) +@@ -120,7 +278,7 @@ + (load lib t) + (fboundp fbound-sym)) + fn)))) +- (t func))) ++ (t (car func)))) + + + (defvar sm-fill-single-line-width 78) +@@ -186,6 +344,10 @@ + (kill-buffer buf))) + (sm-put-header header contents)) + ++(defsubst sm-put-header-contents (header items &optional separator) ++ (sm-put-header header ++ (mapconcat 'identity items (or separator " ")))) ++ + (defsubst sm-put-random-sequence-items (header sequence &optional range) + (sm-put-header-contents header + (apply 'sm-random-sequence-items sequence range))) +@@ -195,17 +357,13 @@ + items + (concat "\n" (make-string sm-fill-indent-width ?\040)))) + +-(defsubst sm-put-header-contents (header items &optional separator) +- (sm-put-header header +- (mapconcat 'identity items (or separator " ")))) +- + (defun sm-put-random-sequence-items-to-eol (header sequence &optional sep) + (or sep (setq sep " ")) + (let ((width (- sm-fill-single-line-width (length header) 2)) + (seqlen (length sequence)) + (len 0) + (continuep t) +- items tem new-len) ++ items tem newlen) + (while continuep + (setq tem (sm-sequence-item sequence (random seqlen))) + (setq newlen (+ len (length sep) (length tem))) +@@ -231,8 +389,29 @@ + (goto-char (match-end 0))))) + (delete-region beg end))) + (insert contents) ++ (setq sm-header-last-inserted header) + (set-buffer-modified-p buf-mod-p)))) + ++(defun sm-delete-header (header) ++ "Delete HEADER and its content is it exists." ++ (save-excursion ++ (let ((buf-mod-p (buffer-modified-p)) ++ (header-exists (mail-position-on-field header))) ++ (if header-exists ++ (delete-region (point) ++ (progn ++ (re-search-backward (concat header ": ")) ++ (forward-char -1) ++ (point))))))) ++ ++(defun sm-delete-last-header () ++ "Delete the last header field inserted by silly-mail." ++ (interactive) ++ (if (not sm-header-last-inserted) ++ (message "Nothing to delete yet") ++ (sm-delete-header sm-header-last-inserted) ++ (setq sm-header-last-inserted nil))) ++ + (put 'sm-put-header-fill-content 'lisp-indent-function 1) + (put 'sm-put-header-contents 'lisp-indent-function 1) + (put 'sm-put-header 'lisp-indent-function 1) +@@ -243,9 +422,14 @@ + (defvar sm-antipastobozoticataclysm-header + "X-Antipastobozoticataclysm") + +-(defvar sm-antipastobozoticataclysm-table +- ["Bariumenemanilow" +- "When George Bush projectile vomits antipasto on the Japanese."]) ++(defcustom sm-antipastobozoticataclysm-table ++ '("Bariumenemanilow" ++ "When George Bush projectile vomits antipasto on the Japanese.") ++ "List of entries for `sm-add-antipastobozoticataclysm'." ++ :type '(set ++ (const "Bariumenemanilow") ++ (const "When George Bush projectile vomits antipasto on the Japanese.")) ++ :group 'silly-mail) + + (defun sm-add-antipastobozoticataclysm () + (interactive) +@@ -267,8 +451,19 @@ + + (defvar sm-drdoom-fodder-header "X-Drdoom-Fodder") + +-(defvar sm-drdoom-fodder-words +- ["CERT" "crash" "crypt" "drdoom" "passwd" "security" "root" "satan"]) ++(defcustom sm-drdoom-fodder-words ++ '("CERT" "crash" "crypt" "drdoom" "passwd" "security" "root" "satan") ++ "List of entries for `sm-add-drdoom-fodder'." ++ :type '(set ++ (const "CERT") ++ (const "crash") ++ (const "crypt") ++ (const "drdoom") ++ (const "passwd") ++ (const "security") ++ (const "root") ++ (const "satan")) ++ :group 'silly-mail) + + (defvar sm-drdoom-fodder-length-range + (list 5 (length sm-drdoom-fodder-words))) +@@ -285,62 +480,118 @@ + ;; These have been contributed by people all over the network + ;; (see the file etc/JOKES or emacs.names in the Emacs 19 distribution). + ;; I modified some of them. +-(defvar sm-emacs-name-table +- ["Each Mail A Continued Surprise" +- "Each Manual's Audience is Completely Stupified" +- "Easily Maintained with the Assistance of Chemical Solutions" +- "Easily Mangles, Aborts, Crashes and Stupifies" +- "Eating Memory And Cycle-Sucking" +- "Editing MACroS" +- "Edwardian Manifestation of All Colonial Sins" +- "Egregious Managers Actively Court Stallman" +- "Eight Megabytes And Constantly Swapping" +- "Eleven Monkeys Asynchronously Create Slogans" +- "Elsewhere Maybe All Commands are Simple" +- "Elsewhere Maybe Alternative Civilizations Survive" +- "Elvis Masterminds All Computer Software" +- "Emacs Macht Alle Computer Schoen" +- "Emacs Made Almost Completely Screwed" +- "Emacs Maintainers Are Crazy Sickos" +- "Emacs Makes A Computer Slow" +- "Emacs Makes All Computing Simple" +- "Emacs Manuals Always Cause Senility" +- "Emacs Manuals Are Cryptic and Surreal" +- "Emacs Masquerades As Comfortable Shell" +- "Emacs May Alienate Clients and Supporters" +- "Emacs May Allow Customised Screwups" +- "Emacs May Annihilate Command Structures" +- "Emacs Means A Crappy Screen" +- "Emacs: My Alternative Computer Story" +- "Embarrassed Manual-Writer Accused of Communist Subversion" +- "Embarrassingly Mundane Advertising Cuts Sales" +- "Emetic Macros Assault Core and Segmentation" +- "Energetic Merchants Always Cultivate Sales" +- "Equine Mammals Are Considerably Smaller" +- "Eradication of Memory Accomplished with Complete Simplicity" +- "Erasing Minds Allows Complete Submission" +- "Escape Meta Alt Control Shift" +- "Esoteric Malleability Always Considered Silly" +- "Even My Aunt Crashes the System" +- "Even a Master of Arts Comes Simpler" +- "Evenings, Mornings, And a Couple of Saturdays" +- "Eventually Munches All Computer Storage" +- "Ever Made A Control-key Setup?" +- "Every Male Adolescent Craves Sex" +- "Every Mode Accelerates Creation of Software" +- "Every Mode Acknowledges Customized Strokes" +- "Every Moron Assumes CCA is Superior" +- "Everyday Material Almost Compiled Successfully" +- "Excavating Mayan Architecture Comes Simpler" +- "Excellent Manuals Are Clearly Suppressed" +- "Exceptionally Mediocre Algorithm for Computer Scientists" +- "Exceptionally Mediocre Autocratic Control System" +- "Experience the Mildest Ad Campaign ever Seen" +- "Extended Macros Are Considered Superfluous" +- "Extensibility and Modifiability Aggravate Confirmed Simpletons" +- "Extraneous Macros And Commands Stink" +- "Generally Not Used (Except by Middle Aged Computer Scientists)"] +- "EMACS acronym expansions.") ++(defcustom sm-emacs-name-table ++ '("Each Mail A Continued Surprise" ++ "Each Manual's Audience is Completely Stupified" ++ "Easily Maintained with the Assistance of Chemical Solutions" ++ "Easily Mangles, Aborts, Crashes and Stupifies" ++ "Eating Memory And Cycle-Sucking" ++ "Editing MACroS" ++ "Edwardian Manifestation of All Colonial Sins" ++ "Egregious Managers Actively Court Stallman" ++ "Eight Megabytes And Constantly Swapping" ++ "Eleven Monkeys Asynchronously Create Slogans" ++ "Elsewhere Maybe All Commands are Simple" ++ "Elsewhere Maybe Alternative Civilizations Survive" ++ "Elvis Masterminds All Computer Software" ++ "Emacs Macht Alle Computer Schoen" ++ "Emacs Made Almost Completely Screwed" ++ "Emacs Maintainers Are Crazy Sickos" ++ "Emacs Makes A Computer Slow" ++ "Emacs Makes All Computing Simple" ++ "Emacs Manuals Always Cause Senility" ++ "Emacs Manuals Are Cryptic and Surreal" ++ "Emacs Masquerades As Comfortable Shell" ++ "Emacs May Alienate Clients and Supporters" ++ "Emacs May Allow Customised Screwups" ++ "Emacs May Annihilate Command Structures" ++ "Emacs Means A Crappy Screen" ++ "Emacs: My Alternative Computer Story" ++ "Embarrassed Manual-Writer Accused of Communist Subversion" ++ "Embarrassingly Mundane Advertising Cuts Sales" ++ "Emetic Macros Assault Core and Segmentation" ++ "Energetic Merchants Always Cultivate Sales" ++ "Equine Mammals Are Considerably Smaller" ++ "Eradication of Memory Accomplished with Complete Simplicity" ++ "Erasing Minds Allows Complete Submission" ++ "Escape Meta Alt Control Shift" ++ "Esoteric Malleability Always Considered Silly" ++ "Even My Aunt Crashes the System" ++ "Even a Master of Arts Comes Simpler" ++ "Evenings, Mornings, And a Couple of Saturdays" ++ "Eventually Munches All Computer Storage" ++ "Ever Made A Control-key Setup?" ++ "Every Male Adolescent Craves Sex" ++ "Every Mode Accelerates Creation of Software" ++ "Every Mode Acknowledges Customized Strokes" ++ "Every Moron Assumes CCA is Superior" ++ "Everyday Material Almost Compiled Successfully" ++ "Excavating Mayan Architecture Comes Simpler" ++ "Excellent Manuals Are Clearly Suppressed" ++ "Exceptionally Mediocre Algorithm for Computer Scientists" ++ "Exceptionally Mediocre Autocratic Control System" ++ "Experience the Mildest Ad Campaign ever Seen" ++ "Extended Macros Are Considered Superfluous" ++ "Extensibility and Modifiability Aggravate Confirmed Simpletons" ++ "Extraneous Macros And Commands Stink" ++ "Generally Not Used (Except by Middle Aged Computer Scientists)") ++ "List of EMACS acronym expansions for `sm-add-emacs-name'." ++ :type '(set ++ (const "Each Mail A Continued Surprise") ++ (const "Each Manual's Audience is Completely Stupified") ++ (const "Easily Maintained with the Assistance of Chemical Solutions") ++ (const "Easily Mangles, Aborts, Crashes and Stupifies") ++ (const "Eating Memory And Cycle-Sucking") ++ (const "Editing MACroS") ++ (const "Edwardian Manifestation of All Colonial Sins") ++ (const "Egregious Managers Actively Court Stallman") ++ (const "Eight Megabytes And Constantly Swapping") ++ (const "Eleven Monkeys Asynchronously Create Slogans") ++ (const "Elsewhere Maybe All Commands are Simple") ++ (const "Elsewhere Maybe Alternative Civilizations Survive") ++ (const "Elvis Masterminds All Computer Software") ++ (const "Emacs Macht Alle Computer Schoen") ++ (const "Emacs Made Almost Completely Screwed") ++ (const "Emacs Maintainers Are Crazy Sickos") ++ (const "Emacs Makes A Computer Slow") ++ (const "Emacs Makes All Computing Simple") ++ (const "Emacs Manuals Always Cause Senility") ++ (const "Emacs Manuals Are Cryptic and Surreal") ++ (const "Emacs Masquerades As Comfortable Shell") ++ (const "Emacs May Alienate Clients and Supporters") ++ (const "Emacs May Allow Customised Screwups") ++ (const "Emacs May Annihilate Command Structures") ++ (const "Emacs Means A Crappy Screen") ++ (const "Emacs: My Alternative Computer Story") ++ (const "Embarrassed Manual-Writer Accused of Communist Subversion") ++ (const "Embarrassingly Mundane Advertising Cuts Sales") ++ (const "Emetic Macros Assault Core and Segmentation") ++ (const "Energetic Merchants Always Cultivate Sales") ++ (const "Equine Mammals Are Considerably Smaller") ++ (const "Eradication of Memory Accomplished with Complete Simplicity") ++ (const "Erasing Minds Allows Complete Submission") ++ (const "Escape Meta Alt Control Shift") ++ (const "Esoteric Malleability Always Considered Silly") ++ (const "Even My Aunt Crashes the System") ++ (const "Even a Master of Arts Comes Simpler") ++ (const "Evenings, Mornings, And a Couple of Saturdays") ++ (const "Eventually Munches All Computer Storage") ++ (const "Ever Made A Control-key Setup?") ++ (const "Every Male Adolescent Craves Sex") ++ (const "Every Mode Accelerates Creation of Software") ++ (const "Every Mode Acknowledges Customized Strokes") ++ (const "Every Moron Assumes CCA is Superior") ++ (const "Everyday Material Almost Compiled Successfully") ++ (const "Excavating Mayan Architecture Comes Simpler") ++ (const "Excellent Manuals Are Clearly Suppressed") ++ (const "Exceptionally Mediocre Algorithm for Computer Scientists") ++ (const "Exceptionally Mediocre Autocratic Control System") ++ (const "Experience the Mildest Ad Campaign ever Seen") ++ (const "Extended Macros Are Considered Superfluous") ++ (const "Extensibility and Modifiability Aggravate Confirmed Simpletons") ++ (const "Extraneous Macros And Commands Stink") ++ (const "Generally Not Used (Except by Middle Aged Computer Scientists)")) ++ :group 'silly-mail) + + (defun sm-add-emacs-name () + (interactive) +@@ -353,57 +604,97 @@ + + (defvar sm-emacs-taunt-header "Emacs") + +-(defvar sm-emacs-taunt-table +- '["(setq software-quality (/ 1 number-of-authors))" +- "a Lisp interpreter masquerading as ... a Lisp interpreter!" +- "a compelling argument for pencil and paper." +- "a learning curve that you can use as a plumb line." +- "a real time environment for simulating molasses-based life forms." +- "an inspiring example of form following function... to Hell." +- "anything free is worth what you paid for it." +- "ballast for RAM." +- "because Hell was full." +- "because editing your files should be a traumatic experience." +- "because extension languages should come with the editor built in." +- "because idle RAM is the Devil's playground." +- "because one operating system isn't enough." +- "because you deserve a brk today." +- "don't cry -- it won't help." +- "don't try this at home, kids!" +- "ed :: 20-megaton hydrogen bomb : firecracker" +- "featuring the world's first municipal garbage collector!" +- "freely redistributable; void where prohibited by law." +- "if SIGINT doesn't work, try a tranquilizer." +- "if it payed rent for disk space, you'd be rich." +- "impress your (remaining) friends and neighbors." +- "it's all fun and games, until somebody tries to edit a file." +- "it's like swatting a fly with a supernova." +- "it's not slow --- it's stately." +- "Lovecraft was an optimist." +- "more boundary conditions than the Middle East." +- "more than just a Lisp interpreter, a text editor as well!" +- "no job too big... no job." +- "or perhaps you'd prefer Russian Roulette, after all?" +- "Our Lady of Perpetual Garbage Collection" +- "resistance is futile; you will be assimilated and byte-compiled." +- "the Swiss Army of Editors." +- "the answer to the world surplus of CPU cycles." +- "the definitive fritterware." +- "the only text editor known to get indigestion." +- "the prosecution rests its case." +- "the road to Hell is paved with extensibility." +- "there's a reason it comes with a built-in psychotherapist." +- "well, why *shouldn't* you pay property taxes on your editor?" +- "where editing text is like playing Paganini on a glass harmonica." +- "you'll understand when you're older, dear."] +- "Facts about Emacs that you and your loved ones should be aware of.") ++(defcustom sm-emacs-taunt-table ++ '("a mistake carried out to perfection." ++ "a moment of convenience, a lifetime of regret." ++ "a terminal disease." ++ "all the problems and twice the bugs." ++ "complex nonsolutions to simple nonproblems." ++ "dissatisfaction guaranteed." ++ "don't get frustrated without it." ++ "even not doing anything would have been better than nothing." ++ "even your dog won't like it." ++ "flaky and built to stay that way." ++ "flawed beyond belief." ++ "foiled again." ++ "form follows malfunction." ++ "garbage at your fingertips." ++ "graphics hacking :: Roman numerals : sqrt (pi)" ++ "ignorance is our most important resource." ++ "it could be worse, but it'll take time." ++ "it could happen to you." ++ "it was hard to write; it should be hard to use." ++ "let it get in *your* way." ++ "live the nightmare." ++ "more than enough rope." ++ "never had it, never will." ++ "no hardware is safe." ++ "power tools for power fools." ++ "power tools for power losers." ++ "putting new limits on productivity." ++ "simplicity made complex." ++ "some voids are better left unfilled." ++ "sometimes you fill a vacuum and it still sucks." ++ "the art of incompetence." ++ "the cutting edge of obsolescence." ++ "the defacto substandard." ++ "the first fully modular software disaster." ++ "the joke that kills." ++ "the problem for your problem." ++ "there's got to be a better way." ++ "warn your friends about it." ++ "you'd better sit down." ++ "you'll envy the dead.") ++ "List of entries for `sm-add-emacs-taunt' (What users said as they collapsed)." ++ :type '(set ++ (const "a mistake carried out to perfection.") ++ (const "a moment of convenience, a lifetime of regret.") ++ (const "a terminal disease.") ++ (const "all the problems and twice the bugs.") ++ (const "complex nonsolutions to simple nonproblems.") ++ (const "dissatisfaction guaranteed.") ++ (const "don't get frustrated without it.") ++ (const "even not doing anything would have been better than nothing.") ++ (const "even your dog won't like it.") ++ (const "flaky and built to stay that way.") ++ (const "flawed beyond belief.") ++ (const "foiled again.") ++ (const "form follows malfunction.") ++ (const "garbage at your fingertips.") ++ (const "graphics hacking :: Roman numerals : sqrt (pi)") ++ (const "ignorance is our most important resource.") ++ (const "it could be worse, but it'll take time.") ++ (const "it could happen to you.") ++ (const "it was hard to write; it should be hard to use.") ++ (const "let it get in *your* way.") ++ (const "live the nightmare.") ++ (const "more than enough rope.") ++ (const "never had it, never will.") ++ (const "no hardware is safe.") ++ (const "power tools for power fools.") ++ (const "power tools for power losers.") ++ (const "putting new limits on productivity.") ++ (const "simplicity made complex.") ++ (const "some voids are better left unfilled.") ++ (const "sometimes you fill a vacuum and it still sucks.") ++ (const "the art of incompetence.") ++ (const "the cutting edge of obsolescence.") ++ (const "the defacto substandard.") ++ (const "the first fully modular software disaster.") ++ (const "the joke that kills.") ++ (const "the problem for your problem.") ++ (const "there's got to be a better way.") ++ (const "warn your friends about it.") ++ (const "you'd better sit down.") ++ (const "you'll envy the dead.")) ++ :group 'silly-mail) + + (defun sm-add-emacs-taunt () + (interactive) +- (sm-put-header sm-emacs-taunt-header ++ (sm-put-header (concat (if sm-always-X-prefix "X-") sm-emacs-taunt-header) + (sm-random-sequence-item sm-emacs-taunt-table))) + +-(setq bizarre-gratuitous-variable '(miscellaneous gratuitous list)) ++;;(setq bizarre-gratuitous-variable '(miscellaneous gratuitous list)) + + + ;; Add an insulting flame into your mail headers. +@@ -446,40 +737,76 @@ + + (defvar sm-meat-header "X-Meat") + +-(defvar sm-meat-table +- ["Abalone" +- "Back Bacon" +- "Bacon" +- "Beef Jerky" +- "Biltong" ; african-style jerky, usually beef, ostrich, or antelope +- "Blood sausage" +- "Buffalo" +- "Calimari" +- "Chicken Fried Steak" +- "Chicken" +- "Clam Jerky" +- "Duck" +- "Flanken" +- "Haggis" +- "Ham" +- "Head cheese" +- "Liverwurst" +- "Lobster" +- "Long pork" +- "Molinari" +- "Olive Loaf" +- "Parma" +- "Prosciutto" +- "Ptarmigan" +- "Roo burgers" +- "Salame" +- "Spruce grouse" +- "Squirrel" +- "Swordfish" +- "Turkey Jerky" +- "Veal" +- "Venison" +- "Wallaby steak"]) ++(defcustom sm-meat-table ++ '("Abalone" ++ "Back Bacon" ++ "Bacon" ++ "Beef Jerky" ++ "Biltong" ; african-style jerky, usually beef, ostrich, or antelope ++ "Blood sausage" ++ "Buffalo" ++ "Calimari" ++ "Chicken Fried Steak" ++ "Chicken" ++ "Clam Jerky" ++ "Duck" ++ "Flanken" ++ "Haggis" ++ "Ham" ++ "Head cheese" ++ "Liverwurst" ++ "Lobster" ++ "Long pork" ++ "Molinari" ++ "Olive Loaf" ++ "Parma" ++ "Prosciutto" ++ "Ptarmigan" ++ "Roo burgers" ++ "Salame" ++ "Spruce grouse" ++ "Squirrel" ++ "Swordfish" ++ "Turkey Jerky" ++ "Veal" ++ "Venison" ++ "Wallaby steak") ++ "List of entries for `sm-add-meat'." ++ :type '(set ++ (const "Abalone") ++ (const "Back Bacon") ++ (const "Bacon") ++ (const "Beef Jerky") ++ (const "Biltong") ++ (const "Blood sausage") ++ (const "Buffalo") ++ (const "Calimari") ++ (const "Chicken Fried Steak") ++ (const "Chicken") ++ (const "Clam Jerky") ++ (const "Duck") ++ (const "Flanken") ++ (const "Haggis") ++ (const "Ham") ++ (const "Head cheese") ++ (const "Liverwurst") ++ (const "Lobster") ++ (const "Long pork") ++ (const "Molinari") ++ (const "Olive Loaf") ++ (const "Parma") ++ (const "Prosciutto") ++ (const "Ptarmigan") ++ (const "Roo burgers") ++ (const "Salame") ++ (const "Spruce grouse") ++ (const "Squirrel") ++ (const "Swordfish") ++ (const "Turkey Jerky") ++ (const "Veal") ++ (const "Venison") ++ (const "Wallaby steak")) ++ :group 'silly-mail) + + (defun sm-add-meat () + (interactive) +@@ -491,20 +818,32 @@ + + (defvar sm-microsoft-header "Microsoft") + +-(defvar sm-microsoft-table +- ["I'm not laughing anymore." +- "Making the world a better place... for Microsoft." +- "Programs so large they have weather." +- "We've got the solution for the problem we sold you." +- "Where `market lock-in' means throwing away the keys." +- "Where even the version numbers aren't Y2K-compliant" +- "Where the service packs are larger than the original releases." +- "With our software, there's no limit to what you can't do!" +- "World domination wasn't enough -- we had to write bad software, too!"]) ++(defcustom sm-microsoft-table ++ '("I'm not laughing anymore." ++ "Making the world a better place... for Microsoft." ++ "Programs so large they have weather." ++ "We've got the solution for the problem we sold you." ++ "Where `market lock-in' means throwing away the keys." ++ "Where even the version numbers aren't Y2K-compliant" ++ "Where the service packs are larger than the original releases." ++ "With our software, there's no limit to what you can't do!" ++ "World domination wasn't enough -- we had to write bad software, too!") ++ "List of entries for `sm-add-microsoft'." ++ :type '(set ++ (const "I'm not laughing anymore.") ++ (const "Making the world a better place... for Microsoft.") ++ (const "Programs so large they have weather.") ++ (const "We've got the solution for the problem we sold you.") ++ (const "Where `market lock-in' means throwing away the keys.") ++ (const "Where even the version numbers aren't Y2K-compliant") ++ (const "Where the service packs are larger than the original releases.") ++ (const "With our software, there's no limit to what you can't do!") ++ (const "World domination wasn't enough -- we had to write bad software, too!")) ++ :group 'silly-mail) + + (defun sm-add-microsoft () + (interactive) +- (sm-put-header sm-microsoft-header ++ (sm-put-header (concat (if sm-always-X-prefix "X-") sm-microsoft-header) + (sm-random-sequence-item sm-microsoft-table))) + + +@@ -547,8 +886,8 @@ + + (defvar sm-tom-swifty-header "X-Tom-Swifty") + +-(defvar sm-tom-swifty-table +- '["\"All the cherry trees are dead,\" Tom said fruitlessly." ++(defcustom sm-tom-swifty-table ++ '("\"All the cherry trees are dead,\" Tom said fruitlessly." + "\"And what should you set your PS1 shell variable to?\" Tom prompted." + "\"Any fresh fruit in the kitchen?\" Tom asked peeringly." + "\"C++ is the wave of the future,\" Tom said objectively." +@@ -645,7 +984,108 @@ + "\"Who drank the last beer?\" Tom asked, hopping mad." + "\"You have new mail,\" Tom said in his usual delivery." + "\"You light up my life,\" Tom said brightly." +- "\"You pinhead,\" Tom said pointedly."]) ++ "\"You pinhead,\" Tom said pointedly.") ++ "List of entries for `sm-add-tom-swifty'." ++ :type '(set ++ (const "\"All the cherry trees are dead,\" Tom said fruitlessly.") ++ (const "\"And what should you set your PS1 shell variable to?\" Tom prompted.") ++ (const "\"Any fresh fruit in the kitchen?\" Tom asked peeringly.") ++ (const "\"C++ is the wave of the future,\" Tom said objectively.") ++ (const "\"Care for some `suan la chow show'?\" Tom asked wantonly.") ++ (const "\"Condensed chicken soup,\" was Tom's canned response.") ++ (const "\"Darling, what vegetable becomes an act of passion when misspelled?\", Tom breathed ravishingly.") ++ (const "\"Eat me,\" was Tom's biting response.") ++ (const "\"Ed is the Standard Text Editor,\" Tom sed.") ++ (const "\"Evergreens have always been my favorite,\" Tom opined.") ++ (const "\"He came at me out of the blue,\" Tom said airily.") ++ (const "\"I am writing lots of little verses,\" Tom said blankly.") ++ (const "\"I can't drink alcohol,\" Tom said spiritually.") ++ (const "\"I can't get this fire started,\" Tom said woodenly.") ++ (const "\"I can't stand baby food,\" Tom said in a strained voice.") ++ (const "\"I can't wait to see the doctor,\" Tom said impatiently.") ++ (const "\"I don't WANNA get drunk,\" Tom wined.") ++ (const "\"I don't have any piano music,\" Tom said listlessly.") ++ (const "\"I don't have the slightest idea how to milk this cow,\" Tom said in utter confusion.") ++ (const "\"I don't understand how square roots work,\" Tom said irrationally.") ++ (const "\"I don't want any champagne!\" Tom said, blowing his top.") ++ (const "\"I feel like I'm running around in circles,\" Tom said squarely.") ++ (const "\"I got to get a text-processor that does my files the right way,\" Tom said awkwardly.") ++ (const "\"I guess I shouldn't have broken the mirror,\" Tom reflected.") ++ (const "\"I hate Frere Jacques,\" Tom said as he roundly denounced it.") ++ (const "\"I have no intention of traversing binary trees!\", Tom barked.") ++ (const "\"I have to finish sorting these writing utensils,\" Tom said pensively.") ++ (const "\"I hope this emulsion works,\" Tom said in suspense.") ++ (const "\"I just burned my hand in the blast furnace,\" Tom said, overwrought.") ++ (const "\"I just don't understand the number seventeen,\" Tom said randomly.") ++ (const "\"I just got some chicken wire,\" Tom said defensively.") ++ (const "\"I just poisoned myself,\" Tom lyed.") ++ (const "\"I just sharpened my pencil,\" Tom said pointedly.") ++ (const "\"I like Gregorian chants,\" Tom intoned.") ++ (const "\"I like amputations,\" Tom said disarmingly.") ++ (const "\"I like sun cartridge tapes,\" Tom said quickly.") ++ (const "\"I never get good bridge hands,\" Tom said in passing.") ++ (const "\"I only like black and white,\" Tom said monotonously.") ++ (const "\"I really like penguins,\" Tom said in a flighty voice.") ++ (const "\"I recommend listening to radio station ``WHAT'',\" Tom said quietly.") ++ (const "\"I think it's time we got married,\" Tom said engagingly.") ++ (const "\"I train dolphins,\" Tom said purposefully.") ++ (const "\"I'll have to grade your test again,\" Tom remarked.") ++ (const "\"I'm completely bankrupt,\" Tom said senselessly.") ++ (const "\"I'm fond of Pavarotti,\" Tom said menacingly.") ++ (const "\"I'm gainfully employed at the Weight-Watchers gymnasium,\" Tom said wastefully.") ++ (const "\"I'm getting fat,\" Tom said expansively.") ++ (const "\"I'm going to copy this tape,\" Tom said for the record.") ++ (const "\"I'm hardly ever aware of what I'm going to do next,\" Tom said unconsciously.") ++ (const "\"I'm having deja-vu,\" Tom said again.") ++ (const "\"I'm really bored,\" Tom said flatly.") ++ (const "\"I'm sorry I broke your window,\" Tom said painfully.") ++ (const "\"I'm sorry to hear I knocked you up,\" Tom said after a pregnant pause.") ++ (const "\"I've burned my tongue,\" Tom said distastefully.") ++ (const "\"I've finished counting the horses,\" Tom said summarily.") ++ (const "\"I've got a bucket full of forearms,\" Tom said wistfully.") ++ (const "\"I've just been drafted,\" Tom said impressively.") ++ (const "\"I've made a complete ash of myself,\" Tom said brazenly.") ++ (const "\"IBM is up 3 points,\" Tom said, taking stock of the situation.") ++ (const "\"If only we could piece together this crime,\" Tom said in a puzzled voice.") ++ (const "\"It needs more seasoning,\" Tom said sagely.") ++ (const "\"It's patently obvious,\" Tom said licentiously.") ++ (const "\"It's really cold out here,\" Tom said in a muffled voice.") ++ (const "\"It's really windy outside,\" said Tom with gusto.") ++ (const "\"Lisp is such a symbol-minded language,\" Tom commonly said.") ++ (const "\"My feet hurt,\" Tom said pedantically.") ++ (const "\"My lenses will stay perfectly clear,\" Tom said optimistically.") ++ (const "\"My mouse buttons don't work,\" Tom said in a depressed voice.") ++ (const "\"My terminal is completely screwed up,\" Tom cursed.") ++ (const "\"On the other hand, eating at a table is more civilized,\" Tom countered.") ++ (const "\"Quick! Change the baby's diaper,\" Tom said rashly.") ++ (const "\"Socialism is dead,\" Tom communicated.") ++ (const "\"The ASCII standard sucks,\" Tom said characteristically.") ++ (const "\"The GNU project will probably not be Posix conformant,\" Tom said noncommittally.") ++ (const "\"The judge sentenced him to the chair,\" Tom said dielectrically.") ++ (const "\"The printer is using too much toner,\" Tom said darkly.") ++ (const "\"The rooster was decapitated,\" Tom said in a crestfallen voice.") ++ (const "\"The sequence `M-4' is equivalent to `C-u 4',\" Tom said metaphorically.") ++ (const "\"The sky is falling,\" Tom said in a crushed voiced.") ++ (const "\"The sun just rose over the cemetary,\" Tom said in mourning.") ++ (const "\"This anesthetic isn't very effective,\" Tom said unnervingly.") ++ (const "\"This awl is broken,\" Tom said pointlessly.") ++ (const "\"This is illegal, I just know it,\" Tom said with conviction.") ++ (const "\"Turn that fan off,\" Tom said coldly.") ++ (const "\"VI is much better than EMACS,\" Tom said with joy.") ++ (const "\"Wait! You need to enable interrupts first!\" Tom said preemptorally.") ++ (const "\"We'll have to take the stairs,\" Tom said in an elevated voice.") ++ (const "\"We're all out of flowers,\" Tom said lackadaisically.") ++ (const "\"We're going to sue you for that window system,\" Tom said inexorably.") ++ (const "\"We're going to use decimal notation,\" Tom said tentatively.") ++ (const "\"Well, I guess we should pitch camp,\" Tom said tentatively.") ++ (const "\"Well, it didn't increase at all,\" Tom said, nonplussed.") ++ (const "\"What is today's date?\" Tom asked in a timely fashion.") ++ (const "\"When will the Hurd be released?\" Tom asked Machingly.") ++ (const "\"Who drank the last beer?\" Tom asked, hopping mad.") ++ (const "\"You have new mail,\" Tom said in his usual delivery.") ++ (const "\"You light up my life,\" Tom said brightly.") ++ (const "\"You pinhead,\" Tom said pointedly.")) ++ :group 'silly-mail) + + (defun sm-add-tom-swifty () + (interactive) +@@ -661,17 +1101,26 @@ + + (defvar sm-tomato-header "Tomato") + +-(defvar sm-tomato-table +- ["Beige" +- "Green" +- "Heliotrope" +- "Mauve" +- "Plaid" +- "Polka-dot"]) ++(defcustom sm-tomato-table ++ '("Beige" ++ "Green" ++ "Heliotrope" ++ "Mauve" ++ "Plaid" ++ "Polka-dot") ++ "List of entries for `sm-add-tomato'." ++ :type '(set ++ (const "Beige") ++ (const "Green") ++ (const "Heliotrope") ++ (const "Mauve") ++ (const "Plaid") ++ (const "Polka-dot")) ++ :group 'silly-mail) + + (defun sm-add-tomato () + (interactive) +- (sm-put-header sm-tomato-header ++ (sm-put-header (concat (if sm-always-X-prefix "X-") sm-tomato-header) + (sm-random-sequence-item sm-tomato-table))) + + +@@ -689,8 +1138,8 @@ + + (defvar sm-x-taunt-header "X-Windows") + +-(defvar sm-x-taunt-table +- '["a mistake carried out to perfection." ++(defcustom sm-x-taunt-table ++ '("a mistake carried out to perfection." + "a moment of convenience, a lifetime of regret." + "a terminal disease." + "all the problems and twice the bugs." +@@ -729,8 +1178,51 @@ + "there's got to be a better way." + "warn your friends about it." + "you'd better sit down." +- "you'll envy the dead."] +- "What users said as they collapsed.") ++ "you'll envy the dead.") ++ "List of entries for `sm-add-x-taunt' (What users said as they collapsed)." ++ :type '(set ++ (const "a mistake carried out to perfection.") ++ (const "a moment of convenience, a lifetime of regret.") ++ (const "a terminal disease.") ++ (const "all the problems and twice the bugs.") ++ (const "complex nonsolutions to simple nonproblems.") ++ (const "dissatisfaction guaranteed.") ++ (const "don't get frustrated without it.") ++ (const "even not doing anything would have been better than nothing.") ++ (const "even your dog won't like it.") ++ (const "flaky and built to stay that way.") ++ (const "flawed beyond belief.") ++ (const "foiled again.") ++ (const "form follows malfunction.") ++ (const "garbage at your fingertips.") ++ (const "graphics hacking :: Roman numerals : sqrt (pi)") ++ (const "ignorance is our most important resource.") ++ (const "it could be worse, but it'll take time.") ++ (const "it could happen to you.") ++ (const "it was hard to write; it should be hard to use.") ++ (const "let it get in *your* way.") ++ (const "live the nightmare.") ++ (const "more than enough rope.") ++ (const "never had it, never will.") ++ (const "no hardware is safe.") ++ (const "power tools for power fools.") ++ (const "power tools for power losers.") ++ (const "putting new limits on productivity.") ++ (const "simplicity made complex.") ++ (const "some voids are better left unfilled.") ++ (const "sometimes you fill a vacuum and it still sucks.") ++ (const "the art of incompetence.") ++ (const "the cutting edge of obsolescence.") ++ (const "the defacto substandard.") ++ (const "the first fully modular software disaster.") ++ (const "the joke that kills.") ++ (const "the problem for your problem.") ++ (const "there's got to be a better way.") ++ (const "warn your friends about it.") ++ (const "you'd better sit down.") ++ (const "you'll envy the dead.")) ++ :group 'silly-mail) ++ + + (defun sm-add-x-taunt () + (interactive) +@@ -747,6 +1239,7 @@ + (or (fboundp 'yow) (load "yow")) + (sm-put-header-fill-content sm-zippy-quote-header (yow))) + ++ + (provide 'silly-mail) + +-;;; silly-mail.el ends here. ++;;; silly-mail.el ends here diff --git a/debian/patches/50_slang-mode_bug336352.diff b/debian/patches/50_slang-mode_bug336352.diff new file mode 100644 index 0000000..b589fdb --- /dev/null +++ b/debian/patches/50_slang-mode_bug336352.diff @@ -0,0 +1,13 @@ +## 50_slang-mode_bug336352.diff by Peter S Galbraith + +--- a/elisp/emacs-goodies-el/slang-mode.el 2004-08-14 23:36:34.000000000 -0400 ++++ b/elisp/emacs-goodies-el/slang-mode.el 2005-10-30 19:53:52.000000000 -0500 +@@ -93,7 +93,7 @@ + :prefix "slang-" + :group 'languages) + +-(defcustom slang-default-application "c:/bin/slsh.exe" ++(defcustom slang-default-application "/usr/bin/slsh" + "Default slang application to run in slang subprocess." + :type 'string + :group 'slang) diff --git a/debian/patches/50_tc.diff b/debian/patches/50_tc.diff new file mode 100644 index 0000000..17a00d8 --- /dev/null +++ b/debian/patches/50_tc.diff @@ -0,0 +1,177 @@ +--- a/elisp/emacs-goodies-el/tc.el ++++ b/elisp/emacs-goodies-el/tc.el +@@ -79,6 +79,12 @@ + ;; start and (mark t) at end. + + ;;; Code: ++;; https://bugs.debian.org/cgi-bin/bugreport.cgi?bug=841059 ++;; Fix by Gijs Hillenius ++(eval-when-compile ++ (when (< emacs-major-version 25) ++ (defmacro save-mark-and-excursion (&rest body) ++ `(save-excursion ,@body)))) + + ;;; ************************************************************ + ;;; External requirements here +@@ -394,7 +400,7 @@ + (defun tc-do-remove-sig () + "Attempt to remove the signature from already quoted text. + Warns if it is longer than 4 lines (5 including signature mark '-- ')." +- (save-excursion ++ (save-mark-and-excursion + (setq tc-removed-sig nil) + (setq tc-removed-sig-marker nil) + (exchange-point-and-mark) +@@ -413,7 +419,7 @@ + "Make the signature be after filling in undo list, and quoted." + (if tc-removed-sig + (progn +- (save-excursion ++ (save-mark-and-excursion + (goto-char (marker-position tc-removed-sig-marker)) + (insert tc-removed-sig) + (let ((sig-end (point-marker))) +@@ -447,7 +453,7 @@ + Replaces any sequence of cite-marks such as \"> |: }\" with a uniform string + of the citemarks of your choice, e.g. \">>>> \"." + (interactive "r") +- (save-excursion ++ (save-mark-and-excursion + (goto-char start) + (let ((end-marker (set-marker (make-marker) end))) + (while (< (point) (marker-position end-marker)) +@@ -479,7 +485,7 @@ + (defun tc-remove-trailing-whitespace () + "Remove trailing whitespace." + ;; First remove trailing empty lines +- (save-excursion ++ (save-mark-and-excursion + (if (< (point) (mark t)) + (exchange-point-and-mark)) + (let ((end-cite (point))) +@@ -543,7 +549,7 @@ + "*Cite the region like `trivial-cite', but without parsing headers. + Doesn't cut the signature either. Region is between START and END." + (interactive "r") +- (save-excursion ++ (save-mark-and-excursion + (if (> start end) + (let ((tmp start)) (setq start end) (setq end tmp))) + (goto-char start) +@@ -572,7 +578,7 @@ + + (defun tc-fix-final-newline () + "Add a newline if there is not one at the end of the cited text." +- (save-excursion ++ (save-mark-and-excursion + (exchange-point-and-mark) + (if (not (bolp)) + (insert "\n")))) +@@ -594,7 +600,7 @@ + Customization: See variables tc-fill-column, tc-remove-signature, + tc-citation-string, tc-make-attribution and tc-header-funs." + (run-hooks 'tc-pre-hook) +- (save-excursion ++ (save-mark-and-excursion + (if (< (mark t) (point)) (exchange-point-and-mark)) + (let ((start (point))) + ;; Initialize some fields +@@ -617,7 +623,7 @@ + (tc-do-remove-sig)) + (tc-remove-trailing-whitespace) + (if tc-max-lines +- (save-excursion ++ (save-mark-and-excursion + (message (concat "Only citing " + (int-to-string tc-max-lines) " lines")) + (goto-char start) +@@ -663,7 +669,7 @@ + paragraph." + (interactive "nLength of citation marks: ") + (let (fill-end) +- (save-excursion ++ (save-mark-and-excursion + (save-restriction + (beginning-of-line) + (let ((cite-marks (buffer-substring (point) (+ (point) cite-len))) +@@ -740,7 +746,7 @@ + "Find the length of the citation marking at point P. + This is so we can fix it when filling. + Used internally in `tc-fill-cited-text'." +- (save-excursion ++ (save-mark-and-excursion + (goto-char p) + (forward-line 1) + (let ((forward-prefix-length (tc-line-common-prefix-length p (point)))) +@@ -773,7 +779,7 @@ + Done on region between START and END. + Uses a seperate undo-mechanism (with overlays) to allow partial undo." + (interactive "r") +- (save-excursion ++ (save-mark-and-excursion + (goto-char start) + (while (< (point) end) + (beginning-of-line) +@@ -797,7 +803,7 @@ + (defun tc-line-common-prefix-length (p1 p2) + "Return the number of characters the two lines have as common prefix. + The two lines are at point P1 and P2." +- (save-excursion ++ (save-mark-and-excursion + (let ((line1 (progn (goto-char p1) (beginning-of-line) + (let ((line-start (point))) + (end-of-line) +@@ -824,7 +830,7 @@ + marks, as it regards the shortest common prefix of the lines as citation + marks." + (interactive "r") +-;;(save-excursion ++;;(save-mark-and-excursion + (goto-char start) + (beginning-of-line) + (let ((line-start (point))) +@@ -851,7 +857,7 @@ + This function finds the longest possible citemark and wraps all lines as + if they had that amount of citemarks." + (interactive "r") +-;;(save-excursion ++;;(save-mark-and-excursion + (goto-char end) + (let ((end-mark (point-marker)) + (cite-marks "")) +@@ -897,7 +903,7 @@ + (interactive "d") + (let ((reformatted (get-char-property at 'tc-reformat))) + (if reformatted +- (save-excursion ++ (save-mark-and-excursion + (let ((removed-region (buffer-substring + (overlay-start (cdr reformatted)) + (overlay-end (cdr reformatted))))) +@@ -923,7 +929,7 @@ + (substring known-marks (length (concat "\n " tc-normal-citemarks))))) + + (defun tc-guess-cite-marks () +- (save-excursion ++ (save-mark-and-excursion + (let ((best-prefix "\n") + guessed-marks + marks-begin marks-end) +@@ -948,7 +954,7 @@ + guessed-marks))) + + (defun tc-citemarks-need-guessing () +- (save-excursion ++ (save-mark-and-excursion + (let ((max-line-len (- (tc-fill-column) (length tc-citation-string) 1)) + needed) + (beginning-of-line) +@@ -967,7 +973,7 @@ + ;; Doesn't work yet. *sniff* + (defun tc-reply-to-citee-p (email) + "Whether the mail being composed is for the person being cited." +- (save-excursion ++ (save-mark-and-excursion + (beginning-of-buffer) + (if (re-search-forward "^To:[ \t]+\\(.*\\)\n" nil t) + (if (equal email (buffer-substring (match-beginning 1) (match-end 1))) diff --git a/debian/patches/50_tlc.diff b/debian/patches/50_tlc.diff new file mode 100644 index 0000000..75857d6 --- /dev/null +++ b/debian/patches/50_tlc.diff @@ -0,0 +1,13 @@ +--- a/elisp/emacs-goodies-el/tlc.el ++++ b/elisp/emacs-goodies-el/tlc.el +@@ -299,8 +299,8 @@ + nil)))) + + ;;; Add to mode list +-;;;###autoload(add-to-list 'auto-mode-alist '("\\.tlc\\'" .tlc-mode)) +-(add-to-list 'auto-mode-alist '("\\.tlc\\'" .tlc-mode)) ++;;;###autoload(add-to-list 'auto-mode-alist '("\\.tlc\\'" . tlc-mode)) ++(add-to-list 'auto-mode-alist '("\\.tlc\\'" . tlc-mode)) + + (provide 'tlc) + diff --git a/debian/patches/50_todoo_bug220718.diff b/debian/patches/50_todoo_bug220718.diff new file mode 100644 index 0000000..a9abbcd --- /dev/null +++ b/debian/patches/50_todoo_bug220718.diff @@ -0,0 +1,26 @@ +## 50_todoo_bug220718.diff by Peter S Galbraith + +--- a/elisp/emacs-goodies-el/todoo.el 2003-10-07 19:18:28.000000000 -0400 ++++ b/elisp/emacs-goodies-el/todoo.el 2003-11-17 15:47:07.000000000 -0500 +@@ -201,10 +201,17 @@ + (define-key map "\C-c\C-n" 'outline-next-visible-heading) + (define-key map "\C-c\M-p" 'todoo-raise-item) + (define-key map "\C-c\M-n" 'todoo-lower-item) +- (define-key map [C-up] 'outline-previous-visible-heading) +- (define-key map [C-down] 'outline-next-visible-heading) +- (define-key map [C-S-up] 'todoo-raise-item) +- (define-key map [C-S-down] 'todoo-lower-item) ++ (cond ++ ((string-match "XEmacs\\|Lucid" emacs-version) ++ (define-key map '(control up) 'outline-previous-visible-heading) ++ (define-key map '(control down) 'outline-next-visible-heading) ++ (define-key map '(control shift up) 'todoo-raise-item) ++ (define-key map '(control shift down) 'todoo-lower-item)) ++ (t ++ (define-key map [C-up] 'outline-previous-visible-heading) ++ (define-key map [C-down] 'outline-next-visible-heading) ++ (define-key map [C-S-up] 'todoo-raise-item) ++ (define-key map [C-S-down] 'todoo-lower-item))) + (setq todoo-mode-map map))) + + ;; Menu diff --git a/debian/patches/51_diminishSamuelBronson.diff b/debian/patches/51_diminishSamuelBronson.diff new file mode 100644 index 0000000..3d2fc3a --- /dev/null +++ b/debian/patches/51_diminishSamuelBronson.diff @@ -0,0 +1,81 @@ +--- a/elisp/emacs-goodies-el/diminish.el ++++ b/elisp/emacs-goodies-el/diminish.el +@@ -8,7 +8,7 @@ + ;; Version: 0.45, 18 Jun 2003 + ;; Keywords: extensions, diminish, minor, codeprose + +-;; This file is part of GNU Emacs. ++;; 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 +@@ -123,6 +123,17 @@ + ;; files perhaps, and then add an eval-after-load? Seems like a kludge + ;; because it relies on outside information remaining constant, but it + ;; would help. ++;; ++;; 2011-01-12 Samuel J. J. Bronson ++;; ++;; - Make `diminished-minor-modes' (probably) Just Work. It should ++;; no longer be necessary ot do anything special in elisp; instead ++;; of trying to minimize computation, we simply redo everything ++;; after any elisp gets loaded. (If this turns out to be too slow, ++;; there are some relatively straightforward improvements that ++;; could be made without having to rely on foreknowledge of what ++;; gets defined where. For example, by keeping track of "pending" ++;; diminished modes and only trying to diminish those.) + + ;;; Code: + +@@ -252,7 +263,7 @@ + (if (eq mode 'diminished-modes) + (let ((diminished-modes diminished-mode-alist)) + (while diminished-modes +- (diminish-undo (caar diminished-modes)) ++ (diminish-undo (caar diminished-modes) annotate-flag) + (callf cdr diminished-modes))) + (let ((minor (assq mode minor-mode-alist)) + (diminished (assq mode diminished-mode-alist))) +@@ -321,10 +332,28 @@ + ;; in line with the ducks and geese at the espresso counter, gazing placidly + ;; out on the world through loon-red eyes, thinking secret thoughts. + ++;;;###autoload ++(defun diminish-maybe-refresh () ++ "Should redo `diminish'ing only if something has changed. ++Right now, do it regardless and hope this isn't too slow." ++ (interactive) ++ (diminish-undo 'diminished-modes t) ++ (mapcar #'(lambda (x) (diminish (car x) (cdr x) t)) ++ diminished-minor-modes)) ++ ++(defun diminish-oneshot-post-command-hook () ++ (diminish-maybe-refresh) ++ (remove-hook 'post-command-hook 'diminish-oneshot-post-command-hook)) ++ ++(defun diminish-after-load-hook (file) ++ (add-hook 'post-command-hook 'diminish-oneshot-post-command-hook)) ++(add-hook 'after-load-functions 'diminish-after-load-hook) ++ + (defgroup diminish nil + "Diminished modes are minor modes with no modeline display." + :group 'convenience) + ++;;;###autoload + (defcustom diminished-minor-modes nil + "List of minor modes to diminish and their mode line display strings. + The display string can be the empty string if you want the name of the mode +@@ -340,11 +369,9 @@ + :value-type (string :tag "Title")) + :options (mapcar 'car minor-mode-alist) + :set (lambda (symbol value) +- (if (and (boundp 'diminished-minor-modes) diminished-minor-modes) +- (mapcar +- (lambda (x) (diminish-undo (car x) t)) diminished-minor-modes)) + (set-default symbol value) +- (mapcar (lambda (x) (diminish (car x) (cdr x) t)) value))) ++ (diminish-maybe-refresh)) ++ :require 'diminish) + + (provide 'diminish) + diff --git a/debian/patches/51_edit-env_copy-list.diff b/debian/patches/51_edit-env_copy-list.diff new file mode 100644 index 0000000..a6c93e7 --- /dev/null +++ b/debian/patches/51_edit-env_copy-list.diff @@ -0,0 +1,30 @@ +## 51_edit-env_copy-list.diff by Peter S Galbraith + +--- a/elisp/emacs-goodies-el/edit-env.el 2006-02-02 22:21:32.000000000 -0500 ++++ b/elisp/emacs-goodies-el/edit-env.el 2006-02-02 22:22:38.000000000 -0500 +@@ -111,6 +111,16 @@ + (list (widget-get widget 'environment-variable-name) + widget))) + ++;; Local copy from `copy-list' from cl.el (PSG, Closes #340735) ++(defun edit-env-copy-list (list) ++ "Return a copy of a list, which may be a dotted list. ++The elements of the list are not copied, just the list structure itself." ++ (if (consp list) ++ (let ((res nil)) ++ (while (consp list) (push (pop list) res)) ++ (prog1 (nreverse res) (setcdr res list))) ++ (car list))) ++ + ;;;###autoload + (defun edit-env () + "Display, edit, delete and add environment variables." +@@ -132,7 +142,7 @@ + (val nil) + (longest-var 0) + (current-widget nil)) +- (setq edit-env-ls (copy-list process-environment)) ++ (setq edit-env-ls (edit-env-copy-list process-environment)) + (setq edit-env-ls (sort edit-env-ls (lambda (a b) (string-lessp a b)))) + + (widget-create 'push-button diff --git a/debian/patches/51_gnus-BTS_bug363161.diff b/debian/patches/51_gnus-BTS_bug363161.diff new file mode 100644 index 0000000..e650cdc --- /dev/null +++ b/debian/patches/51_gnus-BTS_bug363161.diff @@ -0,0 +1,34 @@ +## 51_gnus-BTS_bug363161.diff by + +--- a/elisp/debian-el/gnus-BTS.el 2007-09-18 21:19:47.000000000 -0400 ++++ b/elisp/debian-el/gnus-BTS.el 2007-09-18 21:20:47.000000000 -0400 +@@ -53,6 +53,11 @@ + ;; 2005-09-19 Peter S Galbraith + ;; + ;; Minor bug fix: gnus-dbts-gnus-install missing brackets. ++;; ++;; 2007-09-17 Peter S Galbraith ++;; ++;; Wrong regexp part of gnus-dbts-debian-bug-regexp called by ++;; gnus-dbts-buttonize-debian (Closes #363161, #442438). + ;; + ;;; Code: + +@@ -97,8 +102,6 @@ + (defvar gnus-dbts-debian-reassign-regexp + "reassigned from package `\\([^']*\\)' to `\\([^']*\\)'") + +-(defvar gnus-dbts-debian-bug-regexp "^ *\\([0-9]+\\)") +- + (defun gnus-dbts-browse-debpkg-or-bug (thing) + (interactive "i") + (let* ((the-thing (if (null thing) +@@ -130,7 +133,7 @@ + 'gnus-dbts-in-debian-group-p) + (gnus-dbts-buttonize-debian gnus-dbts-debian-reassign-or-merge-regexp 3 + 'gnus-dbts-in-debian-group-p) +- (gnus-dbts-buttonize-debian gnus-dbts-debian-bug-regexp 1 ++ (gnus-dbts-buttonize-debian gnus-dbts-debian-bug-regexp 3 + 'gnus-dbts-in-debian-devel-announce-group-p) + (gnus-dbts-buttonize-debian gnus-dbts-debian-reassign-regexp 1 + 'gnus-dbts-in-debian-group-p) diff --git a/debian/patches/51_session_autoload.diff b/debian/patches/51_session_autoload.diff new file mode 100644 index 0000000..982c1df --- /dev/null +++ b/debian/patches/51_session_autoload.diff @@ -0,0 +1,12 @@ +## 51_session_autoload.diff by Peter S Galbraith + +--- a/elisp/emacs-goodies-el/session.el ++++ b/elisp/emacs-goodies-el/session.el +@@ -1717,7 +1717,6 @@ + :require 'session + :set 'session-initialize-and-set) + +-;;;###autoload + (defun session-initialize () + "Initialize package session and read previous session file. + Setup hooks and load `session-save-file', see variable `session-initialize'. At diff --git a/debian/patches/51_todoo_bug267637.diff b/debian/patches/51_todoo_bug267637.diff new file mode 100644 index 0000000..36f5809 --- /dev/null +++ b/debian/patches/51_todoo_bug267637.diff @@ -0,0 +1,31 @@ +## 51_todoo_bug267637.diff by Peter S Galbraith + +--- a/elisp/emacs-goodies-el/todoo.el 2004-11-25 21:51:26.000000000 -0500 ++++ b/elisp/emacs-goodies-el/todoo.el 2004-11-25 21:56:39.000000000 -0500 +@@ -57,6 +57,10 @@ + + ;;; ChangeLog: + ++;; 2004-11-24 Peter S Galbraith ++;; Debian bug 267637 fix: changes to outline-regexp should be buffer-local. ++;; Thanks to Daniel Skarda <0rfelyus@hobitin.ucw.cz> for pointing it out. ++ + ;; 1.2 - Fixed bug in menu (todoo-show->todoo) + ;; Fixed bug when deleting window in todoo-save-and-exit + ;; Added early sub-item support (might be buggy, but still +@@ -512,10 +516,11 @@ + (make-local-variable 'font-lock-defaults) + (setq font-lock-defaults '(todoo-font-lock-keywords t)) + +- (setq outline-regexp (concat "^\\(" (regexp-quote todoo-item-marker) " \\|" +- (regexp-quote todoo-item-marker-assigned) +- " \\|[ ]*" (regexp-quote todoo-sub-item-marker) +- " \\)")) ++ (set (make-local-variable 'outline-regexp) ++ (concat "^\\(" (regexp-quote todoo-item-marker) " \\|" ++ (regexp-quote todoo-item-marker-assigned) ++ " \\|[ ]*" (regexp-quote todoo-sub-item-marker) ++ " \\)")) + + (outline-minor-mode 1) + diff --git a/debian/patches/52_gnus-BTS_bug218286.diff b/debian/patches/52_gnus-BTS_bug218286.diff new file mode 100644 index 0000000..9c32b2c --- /dev/null +++ b/debian/patches/52_gnus-BTS_bug218286.diff @@ -0,0 +1,60 @@ +## 52_gnus-BTS_bug218286.diff by + +--- a/elisp/debian-el/gnus-BTS.el 2007-09-24 19:17:09.000000000 -0400 ++++ b/elisp/debian-el/gnus-BTS.el 2007-09-24 19:23:14.000000000 -0400 +@@ -3,7 +3,6 @@ + ;; Copyright (C) 2001 Andreas Fuchs + + ;; Author: Andreas Fuchs +-;; Maintainer: Andreas Fuchs + ;; Keywords: gnus, Debian, Bug + ;; Status: Works in XEmacs (I think >=21) + ;; Created: 2001-02-07 +@@ -59,6 +58,13 @@ + ;; Wrong regexp part of gnus-dbts-debian-bug-regexp called by + ;; gnus-dbts-buttonize-debian (Closes #363161, #442438). + ;; ++;; 2007-09-24 intrigeri ++;; Peter S Galbraith ++;; ++;; Bug#218286: [Fwd: Re: [gnus-BTS] please make bug numbers in mail ++;; clickable to read them as email. ++;; Introduce `gnus-dbts-read-bugs-as-email' ++;; + ;;; Code: + + +@@ -66,6 +72,12 @@ + + (autoload 'thing-at-point "thingatpt") + ++(defcustom gnus-dbts-read-bugs-as-email nil ++ "If t, highlighted Debian bug numbers' buttons call ++ `debian-bug-get-bug-as-email'; else, `browse-url' is used." ++ :type 'boolean ++ :group 'gnus-BTS) ++ + (defvar gnus-dbts-in-debian-group-p nil) + + (defvar gnus-dbts-in-debian-devel-announce-group-p nil) +@@ -102,6 +114,9 @@ + (defvar gnus-dbts-debian-reassign-regexp + "reassigned from package `\\([^']*\\)' to `\\([^']*\\)'") + ++;; debian-bug-get-bug-as-email autoload ++(require 'debian-el-loaddefs) ++ + (defun gnus-dbts-browse-debpkg-or-bug (thing) + (interactive "i") + (let* ((the-thing (if (null thing) +@@ -118,7 +133,9 @@ + (concat + "http://cgi.debian.org/cgi-bin/search_packages.pl" + "?&searchon=names&version=all&release=all&keywords=")))) +- (browse-url (concat url bug-or-feature)))) ++ (if (and bugp gnus-dbts-read-bugs-as-email) ++ (debian-bug-get-bug-as-email bug-or-feature) ++ (browse-url (concat url bug-or-feature))))) + + (defun gnus-dbts-buttonize-debian (regexp num predicate) + (add-to-list 'gnus-button-alist diff --git a/debian/patches/52_todoo_bug414781.diff b/debian/patches/52_todoo_bug414781.diff new file mode 100644 index 0000000..93be659 --- /dev/null +++ b/debian/patches/52_todoo_bug414781.diff @@ -0,0 +1,29 @@ +## 52_todoo_bug414781.diff by + +--- a/elisp/emacs-goodies-el/todoo.el 2007-05-14 19:17:52.000000000 -0400 ++++ b/elisp/emacs-goodies-el/todoo.el 2007-05-14 19:20:51.000000000 -0400 +@@ -57,6 +57,11 @@ + + ;;; ChangeLog: + ++;; 2007-05-14 Peter S Galbraith ++;; Comment out clobbering of outline-mode-menu-bar-map key entries. ++;; This is far too aggressive. A much better fix would be to undefine the ++;; keys for todoo-mode-map. Thanks to Simon Pepping (Closes #144781). ++ + ;; 2004-11-24 Peter S Galbraith + ;; Debian bug 267637 fix: changes to outline-regexp should be buffer-local. + ;; Thanks to Daniel Skarda <0rfelyus@hobitin.ucw.cz> for pointing it out. +@@ -524,9 +529,9 @@ + + (outline-minor-mode 1) + +- (define-key outline-mode-menu-bar-map [headings] 'undefined) +- (define-key outline-mode-menu-bar-map [hide] 'undefined) +- (define-key outline-mode-menu-bar-map [show] 'undefined) ++ ;;(define-key outline-mode-menu-bar-map [headings] 'undefined) ++ ;;(define-key outline-mode-menu-bar-map [hide] 'undefined) ++ ;;(define-key outline-mode-menu-bar-map [show] 'undefined) + + (if todoo-collapse-items + (hide-body)) diff --git a/debian/patches/53_todoo_bug438964.diff b/debian/patches/53_todoo_bug438964.diff new file mode 100644 index 0000000..12196f9 --- /dev/null +++ b/debian/patches/53_todoo_bug438964.diff @@ -0,0 +1,49 @@ +## 53_todoo_bug438964.diff by Peter S Galbraith + +--- a/elisp/emacs-goodies-el/todoo.el 2007-10-23 20:27:08.000000000 -0400 ++++ b/elisp/emacs-goodies-el/todoo.el 2007-10-23 20:27:56.000000000 -0400 +@@ -57,6 +57,12 @@ + + ;;; ChangeLog: + ++;; 2007-08-29 Peter S Galbraith ++ ++;; outline-font-lock-level is void, so define a similar one to historical ++;; version from outline.el. Call it todoo-outline-font-lock-level. ++;; (Closes #438964) ++ + ;; 2007-05-14 Peter S Galbraith + ;; Comment out clobbering of outline-mode-menu-bar-map key entries. + ;; This is far too aggressive. A much better fix would be to undefine the +@@ -389,11 +395,21 @@ + (backward-char)) + + ++(defun todoo-outline-font-lock-level () ++ (let ((count 1)) ++ (save-excursion ++ (outline-back-to-heading t) ++ (while (and (not (bobp)) ++ (not (eq (funcall outline-level) 1))) ++ (outline-up-heading 1) ++ (setq count (1+ count))) ++ count))) ++ + (defun todoo-insert-sub-item () + "Insert a new todoo-sub-item." + (interactive) + (goto-char (- (todoo-item-end) 1)) +- (insert (concat "\n" (make-string (* (- (outline-font-lock-level) 2) ++ (insert (concat "\n" (make-string (* (- (todoo-outline-font-lock-level) 2) + todoo-indent-column) ? ) + todoo-sub-item-marker " \n")) + (backward-char)) +@@ -404,7 +420,7 @@ + (interactive) + (beginning-of-line) + +- (let ((indent-column (* (- (outline-font-lock-level) 1) ++ (let ((indent-column (* (- (todoo-outline-font-lock-level) 1) + todoo-indent-column))) + (if (eq (point) (point-at-eol)) + (insert (make-string indent-column ? ))) diff --git a/debian/patches/56_make_local_hook.diff b/debian/patches/56_make_local_hook.diff new file mode 100644 index 0000000..9359c28 --- /dev/null +++ b/debian/patches/56_make_local_hook.diff @@ -0,0 +1,22 @@ +--- a/elisp/emacs-goodies-el/egocentric.el ++++ b/elisp/emacs-goodies-el/egocentric.el +@@ -101,7 +101,8 @@ + + (defvar egocentric-overlay-list nil + "List of overlays used to highlight occurences of your name in `egocentric-mode'.") +-(make-local-variable 'egocentric-overlay-list) ++(if (fboundp 'make-local-hook) ++ (make-local-variable 'egocentric-overlay-list)) + + (defvar egocentric-regexp-list nil + "Regexp used to check whether a word has to be highlighted. +@@ -141,7 +142,8 @@ + (defun egocentric-mode-on () + "Turn Egocentric mode on." + (interactive) +- (make-local-hook 'post-command-hook) ++ (if (fboundp 'make-local-hook) ++ (make-local-hook 'post-command-hook)) + (add-hook 'post-command-hook (function egocentric-post-command-hook) t t) + (egocentric-update-regexp-list) + (egocentric-insinuate egocentric-regexp-list) diff --git a/debian/patches/series b/debian/patches/series new file mode 100644 index 0000000..8c694ad --- /dev/null +++ b/debian/patches/series @@ -0,0 +1,37 @@ +50_tc.diff +50_rfcview.diff +40_missing_provide.diff +49_bar-cursor-customize.diff +50_bar-cursor_bug331430.diff +50_browse-kill-ring_bug224751.diff +50_ctypes.diff +50_coffee_no-autoload.diff +50_color-theme_custom.diff +50_dedicated.diff +50_diminish-defcustom.diff +51_diminishSamuelBronson.diff +50_edit-env_autoload.diff +51_edit-env_copy-list.diff +50_filladapt_bug420845.diff +50_gnus-BTS.diff +51_gnus-BTS_bug363161.diff +52_gnus-BTS_bug218286.diff +50_highlight-beyond-fill-column.diff +50_joc-toggle-case.diff +50_joc-toggle-buffer.diff +50_maplevtexi.diff +50_marker-visit_autoloads.diff +50_session_enable_custom.diff +51_session_autoload.diff +50_silly-mail.diff +50_slang-mode_bug336352.diff +50_protbuf_custom_and_toggle.diff +50_tlc.diff +50_todoo_bug220718.diff +51_todoo_bug267637.diff +52_todoo_bug414781.diff +53_todoo_bug438964.diff +50_setnu.diff +50_quack_autoload.diff +56_make_local_hook.diff +50_minibuf-electric.diff diff --git a/debian/rules b/debian/rules new file mode 100755 index 0000000..a5b00e1 --- /dev/null +++ b/debian/rules @@ -0,0 +1,25 @@ +#!/usr/bin/make -f + +include /usr/share/quilt/quilt.make + +%: + dh $@ --with quilt + +override_dh_auto_build: + for i in debian/*.emacsen-install.in ; do cat $$i debian/emacsen-install.template > debian/$$(basename $$i .in) ; done + for i in debian/*.emacsen-remove.in ; do cat $$i debian/emacsen-remove.template > debian/$$(basename $$i .in) ; done + install -d info + makeinfo elisp/emacs-goodies-el/emacs-goodies-el.texi + makeinfo elisp/debian-el/debian-el.texi + makeinfo -o info/ elisp/emacs-goodies-el/maplev.texi + dh_auto_build + +override_dh_installemacsen: + dh_installemacsen -Ndebian-el + dh_installemacsen -pdebian-el --priority=51 + +override_dh_auto_clean: + for i in debian/*.emacsen-install.in ; do rm -f debian/$$(basename $$i .in) ; done + for i in debian/*.emacsen-remove.in ; do rm -f debian/$$(basename $$i .in) ; done + rm -fR info + dh_auto_clean diff --git a/debian/source/format b/debian/source/format new file mode 100755 index 0000000..89ae9db --- /dev/null +++ b/debian/source/format @@ -0,0 +1 @@ +3.0 (native) diff --git a/elisp/debian-el/apt-sources.el b/elisp/debian-el/apt-sources.el new file mode 100755 index 0000000..e6458f2 --- /dev/null +++ b/elisp/debian-el/apt-sources.el @@ -0,0 +1,524 @@ +;;; apt-sources.el --- Mode for editing apt source.list file +;; +;; Version: 0.9.9 +;; $Revision: +;; $Id: +;; $Source: + +;; Author: Dr. Rafael Seplveda. +;; Maintainer: Peter S. Galbraith +;; (I can't find Dr. Rafael Seplveda) + +;; Copyright (C) 2001-2003, Dr. Rafael Seplveda +;; Copyright (C) 2009 Peter S. Galbraith + +;; 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. + +;; 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 mode is for editing '/etc/apt/sources.list', the APT (Advanced +;; Package Tool) configuration file found on Debian systems. + +;; APT is a package retrieval tool for Debian (a GNU distribution, see +;; http://www.debian.org); for example you could install Emacs with +;; the command: +;; +;; apt-get install emacs21 +;; +;; and APT will then retrieve the package and install it for you. The +;; sources.list file tells APT where to look for packages. Mine looks +;; like this: +;; +;; deb http://http.us.debian.org/debian unstable main contrib +;; deb http://non-us.debian.org/debian-non-US unstable/non-US main +;; +;; deb ftp://ftp.de.debian.org/debian ../project/experimental main +;; +;; This mode font-locks the file and add some things including new +;; source lines and modifying existing source lines. +;; +;; This mode can be customized in diferent parts. You can (interactively) +;; change if you want blank lines around a new source line and comment +;; with `apt-sources-around-lines'. Also you can change the way that +;; this mode names each source line, with variable`apt-sources-source-name'; +;; if no name is entered, no commente name will be inserted. +;; To customize, try `M-x customize-group [RET] apt-sources' +;; +;; You can modify existing parts of the source line; check the mode +;; documentation for mor details. Another thing that this mode can do is to +;; replicate an existing line (`C-c C-r') that will be changed to the 'deb' or +;; 'deb-src' corresponding line. If it replicates a 'deb' line, an identical +;; 'deb-src' source line will be created. +;; +;; To load this mode, you can add a "Local Variables" block at the end of +;; the sources.list file with `C-c C-v' after you change the file's mode to +;; 'apt-sources'. But this should not be needed since an entry is added to +;; `auto-mode-alist' to automatically enter this mode when editing files +;; named `sources.list'. +;; +;; You can always find the latest version of this mode on +;; 'http://people.gnulinux.org.mx/drs/emacs/apt-sources.el' + +;;; TODO: + +;;; History: + +;; 0.9.9 2009-11-25 Peter S. Galbraith +;; -- Create syntax table and add comments. (Closes: #469971) +;; 0.9.8 -- Remove dependency to autoinsert, because it's no longer required. +;; (suggested by Peter S. Galbraith ) +;; 0.9.7 -- Converted relevant defvar statements to defcustom, and added +;; `auto-mode-alist' entry. (Peter S. Galbraith ) +;; -- Add completion to some of the fields in `apt-sources-new-source' +;; and the functions that change parameters. (suggested by +;; Peter S. Galbraith ) +;; -- Add menu support. (suggested by Peter S. Galbraith ) +;; -- Change name from `apt-sources-insert-source' to +;; `apt-sources-new-source'. (suggested by Peter S. Galbraith +;; ) +;; -- Change name from `apt-sources-insert-local-var' to +;; `apt-sources-insert-local-vars'. (suggested by Peter S. Galbraith +;; ) +;; -- Change `apt-sources-change-components' to handle absence of +;; components. (Dr. Rafael Seplveda ) +;; -- Change the web page address form where you can find the latest version. +;; (Dr. Rafael Seplveda ) +;; 0.9.6 -- Added a better description to what is APT and file 'sources.list'. +;; (Ole Laursen ) +;; 0.9.5 -- Fixed typo in docstring of function `apt-sources-around-lines'. +;; -- Rewrite function `apt-sources-around-lines' with a better algorithm. +;; (John Paul Wallington ) +;; -- Added a description to apt and sources.list +;; (David Combs ) +;; -- Added name and email from contributors. :) +;; (Dr. Rafael Seplveda ) +;; 0.9.4 -- Added a missing option in function `apt-sources-insert-source' to +;; select 'ftp' type. +;; -- Added URI-type 'https'. +;; -- Fix some function's documentation mistakes. +;; (Dr. Rafael Seplveda ) +;; 0.9.3 -- Fix a recently introduced bug that prevents keybindings work under +;; Xemacs. +;; (John Paul Wallington ) +;; 0.9.2 -- Fix a bug with a keybinding that called a function with another name. +;; -- Make variable `comment-start' buffer-local. +;; -- Change the keybinding zone to be more compact and portable. +;; (John Paul Wallington ) +;; -- Change some keybindings. +;; (Dr. Rafael Seplveda ) +;; +;; 0.9.1 -- Corrected a bug in the 'cond' clauses that prevented to byte-compile. +;; (Perkens-Golomb, Burkhard )' +;; -- Make variable `comment-start-skip' buffer-local. +;; (Stefan Monnier ) +;; 0.9 -- first release. +;; (Dr. Rafael Seplveda ) + +;;; Code: + +;;(require 'autoinsert) + +(defgroup apt-sources nil "Mode for editing apt source.list file" + :group 'tools + :prefix "apt-sources-") + +(defcustom apt-sources-mode-hook nil + "*Hook for customising apt-sources mode." + :type 'hook + :group 'apt-sources) + +(defcustom apt-sources-load-hook nil + "*Hook run when the `apt-sources-mode' is loaded." + :type 'hook + :group 'apt-sources) + +(defcustom apt-sources-around-lines t + "Put blank lines around the inserted source lines. +This variable can be changed by function `apt-sources-around-lines'" + :type 'boolean + :group 'apt-sources) + +(defcustom apt-sources-source-name "##\n## %s\n##\n\n" + "Format used in the name of a new source line. +This line is inserted by `apt-source-new-source' function. You can +use ANSI quoting as described in the info elisp manual, chapter +'Character Type'. The '%s' is where the name of the source line will be +inserted." + :type 'string + :group 'apt-sources) + +(defvar apt-sources-mode-syntax-table nil + "Syntax table used in `apt-sources-mode' buffers.") +(if apt-sources-mode-syntax-table + () + (setq apt-sources-mode-syntax-table (make-syntax-table)) + + ;; Support # style comments + (modify-syntax-entry ?# "<" apt-sources-mode-syntax-table) + (modify-syntax-entry ?\n "> " apt-sources-mode-syntax-table)) + +;;Regexps for identifying source line parts for font-lock. +(defvar apt-sources-font-lock-deb-regexp "\\(deb\\|deb-src\\)" + "A regexp that matches 'deb' or 'deb-src' at the begining of line.") + +(defvar apt-sources-font-lock-uri-regexp + "\\([^ ]+\\)" + "A regexp that matches the URI part of the source line.") + +(defvar apt-sources-font-lock-distribution-regexp + "\\([^ ]+\\)" + "A regexp that matches the distribution name part of the source line.") + + +(defvar apt-sources-font-lock-keywords + (list + ;; Comments + ;;'("^#.*$" . font-lock-comment-face) + ;; sources.list lines: + ;; deb http://http.us.debian.org/debian unstable main contrib + (cons + (concat "^" + apt-sources-font-lock-deb-regexp " +" + apt-sources-font-lock-uri-regexp " +" + apt-sources-font-lock-distribution-regexp + " +\\([^#\n]+\\)") + '( + (1 font-lock-constant-face) + (2 font-lock-variable-name-face) + (3 font-lock-type-face) + (4 font-lock-keyword-face)))) + "Info for function `font-lock-mode'.") + +(defvar apt-sources-mode-map nil + "Keymap used in apt-sources mode.") + +(unless apt-sources-mode-map + (let ((map (make-sparse-keymap))) + + ;; Keybindings + (define-key map (kbd "C-c C-i") 'apt-sources-new-source) + (define-key map (kbd "C-c C-l") 'apt-sources-around-lines) + (define-key map (kbd "C-c C-v") 'apt-sources-insert-local-vars) + (define-key map (kbd "C-c C-r") 'apt-sources-deb-or-src-replicate) + + (define-key map (kbd "C-c C-s") 'apt-sources-change-source-type) + (define-key map (kbd "C-c C-t") 'apt-sources-change-uri-type) + (define-key map (kbd "C-c C-a") 'apt-sources-change-uri-address) + (define-key map (kbd "C-c C-d") 'apt-sources-change-distribution) + (define-key map (kbd "C-c C-c") 'apt-sources-change-components) + + (define-key map (kbd "C-c C-n") 'apt-sources-next-source-line) + (define-key map (kbd "C-c C-p") 'apt-sources-previous-source-line) + (setq apt-sources-mode-map map) + + ;; Menu + (define-key apt-sources-mode-map [menu-bar] (make-sparse-keymap)) + (define-key apt-sources-mode-map [menu-bar apt-sources] + (cons "Apt-sources" map)) + + (define-key map [menu-bar apt-sources previous-source-line] + '("Go to previous source line" . apt-sources-previous-source-line)) + (define-key map [menu-bar apt-sources next-source-line] + '("Go to next source line" . apt-sources-next-source-line)) + (define-key map [menu-bar apt-sources separator-actions] + '("--")) + (define-key map [menu-bar apt-sources change-components] + '("Change components" . apt-sources-change-components)) + (define-key map [menu-bar apt-sources change-distribution] + '("Change distribution" . apt-sources-change-distribution)) + (define-key map [menu-bar apt-sources change-uri-address] + '("Change URI address" . apt-sources-change-uri-address)) + (define-key map [menu-bar apt-sources change-uri-type] + '("Change URI type" . apt-sources-change-uri-type)) + (define-key map [menu-bar apt-sources change-source-type] + '("Change source type" . apt-sources-change-source-type)) + (define-key map [menu-bar apt-sources separator-changes] + '("--")) + (define-key map [menu-bar apt-sources insert-local-vars] + '("Insert local variables" . apt-sources-insert-local-vars)) + (define-key map [menu-bar apt-sources around-lines] + '("Toogle empty lines between source" . apt-sources-around-lines)) + (define-key map [menu-bar apt-sources deb-or-src-replicate] + '("Copy source changing type" . apt-sources-deb-or-src-replicate)) + (define-key map [menu-bar apt-sources new-source] + '("Add new source" . apt-sources-new-source)))) + + + +;;;###autoload +(defun apt-sources-mode () + "Major mode for editing apt's sources.list file. +Sets up command `font-lock-mode'. + +\\{apt-sources-mode-map}" + (interactive) + ;; + (kill-all-local-variables) + (setq mode-name "apt-sources") + (setq major-mode 'apt-sources-mode) + (use-local-map apt-sources-mode-map) + ;; + (set (make-local-variable 'comment-start) "#") + (set (make-local-variable 'comment-start-skip) "#+ *") + (set-syntax-table apt-sources-mode-syntax-table) + ;; + (make-local-variable 'font-lock-defaults) + (setq font-lock-defaults '(apt-sources-font-lock-keywords)) + ;; + (run-hooks 'apt-sources-mode-hook)) + + + +(defun apt-sources-new-source (name) + "Insert interactively a new source line into the current buffer. +This will insert a new source in the current line. + +NAME is the name you want to this source line; it will be a comment. + If no NAME is entered, only the line will be inserted. + +You should read sources.list documentation for further explanation +of the format." + (interactive "*sName of new source: ") + + (let ((source-type (completing-read "Source type: " '(("deb" 1) ("deb-src" 2)) nil t)) + (uri-type (completing-read "URI type: " ;type used to retrieve the URI, like http, ftp, etc. + '(("cdrom:/" 1) + ("copy://" 2) + ("file://" 3) + ("ftp://" 4) + ("http://" 5) + ("https://" 6) + ("rsh://" 7) + ("ssh://" 8)) nil t)) + (uri-address (read-from-minibuffer "URI address: ")) ;URI that will be used to specify the base + ;of the Debian distribution, from which APT + ;will find the information it needs. + (distribution (completing-read "Distribution: " ;specific arquitecture or an exact path. + '(("unstable" 1) + ("testing" 2) + ("frozen" 3) + ("stable" 4) + ("sid" 5) + ("squeeze" 6) + ("wheezy" 7) + ("jessie" 8)) nil t)) + (components (completing-read "Components: " ;list of componenst used by APT. + '(("main") + ("main contrib") + ("main contrib non-free") + ("contrib") + ("contrib non-free") + ("non-free")))) + (blank-line (if apt-sources-around-lines "\n" ""))) + + (save-excursion + (beginning-of-line) + (insert blank-line) ;insert line if `apt-sources-around-lines' + (and (< 0 (length name)) + (insert (format apt-sources-source-name name))) + (insert ;insert rest of arguments except components + (format "%s %s%s %s" source-type uri-type uri-address distribution)) + + ;if `distribution' ends in '/', then don't process components. + (if (string-match "/$" distribution) + distribution + (insert " " components) + (insert blank-line))))) ;insert line if `apt-sources-around-lines' + + +(defun apt-sources-around-lines () + "Toggle insertion of newlines around a future creation of source lines. +This modifies the state of variable `apt-sources-around-lines'." + (interactive) + (setq apt-sources-around-lines (not apt-sources-around-lines)) + (message "Surrounding blank lines %s" + (if apt-sources-around-lines "On" "Off"))) + + +(defun apt-sources-insert-local-vars () + "Insert the current values of buffer local variables." + (interactive) + (end-of-buffer) + (and (not (bolp)) + (insert "\n")) ;insert a newline if the file doesn't end in a blank line. + (insert "\n" + comment-start " Local " "Variables:\n" + comment-start " mode: " (format "%s\n" (or mode-name "apt-sources")) + comment-start " End:\n")) + + +(defun apt-sources-next-source-line (arg) + "Go to the next source line. + +ARG is the prefix argument." + (interactive "p") + (let ((source-line-search (if (> arg 0) + (progn + (end-of-line) + 're-search-forward) + 're-search-backward))) + (and (apply source-line-search + '("^\\(deb \\|deb-src \\)" nil)) + (beginning-of-line)))) + + +(defun apt-sources-previous-source-line () + "Go to the previous source line." + (interactive) + (apt-sources-next-source-line -1)) + + +;;Modifying functions +(defun apt-sources-source-line-p () + "Return t if we are in an apt source line." + (save-excursion + (if (progn (beginning-of-line) + (re-search-forward "^deb[^ ]*" (line-end-position) t 1)) + t ;return t if we are in an apt source line + (message "Not in a source line!") + nil))) ;return nil if we aren't in an apt source line + + +(defun apt-sources-change-source-type () + "Change the type of the source line. +TYPE is either 'd' or 's' to change the type to 'deb' or 'deb-src'. + +This function will rise an error if we are not in a source line." + (interactive) + (and (apt-sources-source-line-p) + ;type used to retrieve the URI, like http, ftp, etc. + (let ((new-type (completing-read "'deb' or 'deb-src': " '(("deb" 1) ("deb-src" 2)) nil t))) + (save-excursion + (beginning-of-line) + (delete-region (point) (re-search-forward "^deb[^ ]*" (line-end-position) nil 1)) + (insert new-type))))) + + +(defun apt-sources-change-uri-type () + "Change the URI type of the source line. + +This function will rise an error if we are not in a source line." + (interactive) + + (and (apt-sources-source-line-p) + (let ((uri-type (completing-read "URI type: " ;type used to retrieve the URI, like http, ftp, etc. + '(("cdrom:/" 1) + ("copy://" 2) + ("file://" 3) + ("ftp://" 4) + ("http://" 5) + ("https://" 6) + ("rsh://" 7) + ("ssh://" 8)) nil t))) + (save-excursion + (beginning-of-line) + (delete-region (re-search-forward "^deb[^ ]*." (line-end-position) nil 1) + (re-search-forward ":/*" (line-end-position) nil 1)) + (insert uri-type))))) + + +(defun apt-sources-change-uri-address (uri-address) + "Change the URI address of the source line. +String URI-ADDRESS is the address (without the type of address, +ex: 'http://'). + +This function will rise an error if we are not in a source line." + (interactive "sURI address: ") + + (and (apt-sources-source-line-p) + (save-excursion + (beginning-of-line) + (delete-region (re-search-forward ":/*" (line-end-position) nil 1) + (re-search-forward "[^ ]*" (line-end-position) nil 1)) + (insert uri-address)))) + + +(defun apt-sources-change-distribution () + "Change the distribution of the source line. + +This function will rise an error if we are not in a source line." + (interactive) + + (and (apt-sources-source-line-p) + (let ((distribution (completing-read "Distribution: " ;specific arquitecture or an exact path. + '(("unstable" 1) + ("testing" 2) + ("frozen" 3) + ("stable" 4) + ("sid" 5) + ("squeeze" 6) + ("wheezy" 7) + ("jessie" 8)) nil t))) + (save-excursion + (beginning-of-line) + (delete-region (re-search-forward ":/*[^ ]*." (line-end-position) t 1) + (re-search-forward "[^ ]*" (line-end-position) t 1)) + (insert distribution))))) + + +(defun apt-sources-change-components () + "Change the components of the source line. + +This function will rise an error if we are not in a source line." + (interactive) + + (and (apt-sources-source-line-p) + (let ((components (completing-read "Components: " ;list of componenst used by APT. + '(("main") + ("main contrib") + ("main contrib non-free") + ("contrib") + ("contrib non-free") + ("non-free"))))) + (save-excursion + (beginning-of-line) + (delete-region (re-search-forward ":/*[^ ]* [^ ]*." (line-end-position) t 1) + (line-end-position)) + (and (save-excursion + (backward-char) + (looking-at "[^ ]")) + (insert " ")) + (insert components))))) + + + +(defun apt-sources-deb-or-src-replicate () + "Copy the source line and change the 'deb' to 'deb-src' or viceversa. + +This function will rise an error if we are not on a source line." + (interactive) + + (and (apt-sources-source-line-p) + (let ((copy (buffer-substring (line-beginning-position) + (line-end-position)))) + (save-excursion + (end-of-line) + (insert (concat "\n" copy)) + (beginning-of-line) + (if (re-search-forward "^deb " (line-end-position) t 1) + (progn + (backward-char) + (insert "-src")) + (delete-region (line-beginning-position) + (re-search-forward "^deb[^ ]*" (line-end-position) t 1)) + (insert "deb")))))) + + + +(run-hooks 'apt-sources-load-hook) +(add-to-list 'auto-mode-alist '("sources\\.list\\'" . apt-sources-mode)) +(add-to-list 'auto-mode-alist '("sources\\.list\\.d/.*\\.list\\'" . apt-sources-mode)) +(provide 'apt-sources) + +;;; apt-sources.el ends here diff --git a/elisp/debian-el/apt-utils.el b/elisp/debian-el/apt-utils.el new file mode 100644 index 0000000..297fef4 --- /dev/null +++ b/elisp/debian-el/apt-utils.el @@ -0,0 +1,2116 @@ +;;; apt-utils.el --- Emacs interface to APT (Debian package management) + +;;; Copyright (C) 2002-2010 Matthew P. Hodges + +;; Author: Matthew P. Hodges +;; $Id: apt-utils.el,v 1.23 2016/11/05 22:18:48 psg Exp $ + +;; apt-utils.el 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. + +;; apt-utils.el 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: +;; +;; Package to interface Emacs with APT. Start things off using e.g.: +;; M-x apt-utils-show-package RET emacs21 RET +;; +;; Other packages (dependencies, conflicts etc.) can be navigated +;; using apt-utils-{next,previous}-package, +;; apt-utils-choose-package-link or apt-utils-follow-link. Return to +;; the previous package with apt-utils-view-previous-package. +;; ChangeLog and README files for the current package can easily be +;; accessed with, for example, apt-utils-view-changelog. +;; +;; For normal (i.e., not virtual) packages, the information can be +;; toggled between `package' and `showpkg' displays using +;; apt-utils-toggle-package-info; the latter is useful for the +;; "Reverse Depends". +;; +;; View the key bindings with describe-mode (bound to ? by default). + +;;; Code: + +(defconst apt-utils-version "2.12.0" + "Version number of this package.") + +(require 'browse-url) +(require 'jka-compr) +(require 'thingatpt) + +(defalias 'apt-utils-puthash 'puthash) + +;; Customizable variables + +(defgroup apt-utils nil + "Emacs interface to APT (Debian package management)." + :group 'tools + :link '(url-link "http://mph-emacs-pkgs.alioth.debian.org/AptUtilsEl.html")) + +(defcustom apt-utils-fill-packages t + "*Fill APT package names if t." + :group 'apt-utils + :type 'boolean) + +(defcustom apt-utils-show-link-info t + "*Show APT package descriptions when cycling through links if t." + :group 'apt-utils + :type 'boolean) + +(defcustom apt-utils-show-all-versions nil + "*Show APT descriptions for multiple package versions if t." + :group 'apt-utils + :type 'boolean) + +(defcustom apt-utils-automatic-update 'ask + "*Controls automatic rebuilding of APT package lists. + +If t always rebuilt when `apt-utils-timestamped-file' is newer +than the timestamp stored in `apt-utils-package-list-built'. If +equal to the symbol ask, ask the user about the update. If nil, +never update automatically." + :group 'apt-utils + :type '(choice (const :tag "Always update automatically" t) + (const :tag "Ask user about update" ask) + (const :tag "Never update automatically" nil))) + +(defcustom apt-utils-grep-dctrl-args '("-e") + "*List of arguments to pass to `apt-utils-grep-dctrl-program'." + :group 'apt-utils + :type '(repeat string)) + +(defcustom apt-utils-kill-buffer-confirmation-function 'yes-or-no-p + "Function called before killing any buffers. +The function is called with one argument, which is a prompt. +Suitable non-nil values include `yes-or-no-p', `y-or-n-p' and +`ignore'." + :group 'apt-utils + :type '(choice (const :tag "Kill buffers only after yes or no query" yes-or-no-p) + (const :tag "Kill buffers only after y or n query" y-or-n-p) + (const :tag "Never kill buffers" ignore) + (const :tag "Kill buffers without confirmation" nil))) + +(defcustom apt-utils-search-split-regexp "\\s-*&&\\s-*" + "Regular expression used to split multiple search terms. +See `apt-utils-search' and `apt-utils-search-names-only'." + :group 'apt-utils + :type 'regexp) + +(defcustom apt-utils-web-browse-debian-changelog-url + "http://packages.debian.org/changelogs/pool/main/%d/%s/%s_%v/changelog" + "Template URL for Debian ChangeLog files. +See `apt-utils-web-format-url'." + :group 'apt-utils + :type 'string) + +(defcustom apt-utils-web-browse-bug-reports-url + "http://bugs.debian.org/%p" + "Template URL for Debian bug reports. +See `apt-utils-web-format-url'." + :group 'apt-utils + :type 'string) + +(defcustom apt-utils-web-browse-copyright-url + "http://packages.debian.org/changelogs/pool/main/%d/%s/%s_%v/%p.copyright" + "Template URL for Debian copyright files. +See `apt-utils-web-format-url'." + :group 'apt-utils + :type 'string) + +(defcustom apt-utils-web-browse-versions-url + "http://packages.debian.org/%p" + "Template URL for Debian version information. +See `apt-utils-web-format-url'." + :group 'apt-utils + :type 'string) + +(defcustom apt-utils-show-package-hooks nil + "Hooks to be run after presenting package information." + :group 'apt-utils + :type 'hook) + +(defcustom apt-utils-use-current-window nil + "If non-nil always display APT utils buffers in the current window. +In this case `switch-to-buffer' is used to select the APT utils +buffer. If nil, `display-buffer' is used, and the precise +behaviour depends on the value of `pop-up-windows'." + :group 'apt-utils + :type 'boolean) + +(defcustom apt-utils-dpkg-program "/usr/bin/dpkg" + "Location of the dpkg program. +This can be set to dlocate, which has the advantage of better +performance, but uses cached data that may be out of date." + :group 'apt-utils + :type '(choice (const :tag "dpkg" "/usr/bin/dpkg") + (const : tag "dlocate" "/usr/bin/dlocate") + (file :must-match t))) + +(defcustom apt-utils-display-installed-status t + "If non-nil display the installed status of the current package." + :group 'apt-utils + :type 'boolean) + +;; Faces + +(defface apt-utils-normal-package-face + '((((class color) (background light)) + (:foreground "blue")) + (((class color) (background dark)) + (:foreground "yellow"))) + "Face used for APT normal package hyperlinks." + :group 'apt-utils) + +(defface apt-utils-normal-installed-package-face + '((((class color)) + (:inherit apt-utils-normal-package-face :bold t))) + "Face used for APT installed package hyperlinks." + :group 'apt-utils) + +(defface apt-utils-virtual-package-face + '((((class color) (background light)) + (:foreground "green4")) + (((class color) (background dark)) + (:foreground "green"))) + "Face used for APT virtual package hyperlinks." + :group 'apt-utils) + +(defface apt-utils-field-keyword-face + '((((class color) (background light)) + (:foreground "purple" :bold t)) + (((class color) (background dark)) + (:foreground "purple" :bold t))) + "Face used for APT field keywords." + :group 'apt-utils) + +(defface apt-utils-field-contents-face + '((((class color) (background light)) + (:foreground "orchid")) + (((class color) (background dark)) + (:foreground "orange"))) + "Face used for APT field contents." + :group 'apt-utils) + +(defface apt-utils-description-face + '((((class color)) + (:foreground "cadet blue"))) + "Face used for APT package description." + :group 'apt-utils) + +(defface apt-utils-version-face + '((((class color)) + (:italic t))) + "Face used for APT package versions." + :group 'apt-utils) + +(defface apt-utils-broken-face + '((((class color)) + (:foreground "red"))) + "Face used for unknown APT package." + :group 'apt-utils) + +(defface apt-utils-file-face + '((((class color)) + (:foreground "brown"))) + "Face used for files." + :group 'apt-utils) + +(defface apt-utils-installed-status-face + '((((class color)) + (:italic t))) + "Face used for installed status." + :group 'apt-utils) + +;; Other variables + +(defvar apt-utils-apt-cache-program "/usr/bin/apt-cache" + "Location of the apt-cache program.") + +(defvar apt-utils-grep-dctrl-program "/usr/bin/grep-dctrl" + "Location of the grep-dctrl program.") + +(defvar apt-utils-grep-dctrl-file-directory "/var/lib/apt/lists" + "Directory used by `apt-utils-search-grep-dctrl'. +See also `apt-utils-grep-dctrl-file-list'.") + +(defvar apt-utils-grep-dctrl-file-list nil + "List of files searched by `apt-utils-search-grep-dctrl'. +If no list is specified, this is computed on demand from files in +`apt-utils-grep-dctrl-file-directory'.") + +(defvar apt-utils-package-list nil + "Hash table containing APT packages types.") + +(defvar apt-utils-package-list-built nil + "If non-nil, a timestamp for the APT package list data.") + +(defvar apt-utils-package-history nil + "History of packages for each `apt-utils-mode' buffer.") +(make-variable-buffer-local 'apt-utils-package-history) + +(defvar apt-utils-current-links nil + "Package links associated with the `apt-utils-mode' buffer.") +(make-variable-buffer-local 'apt-utils-current-links) + +(defvar apt-utils-buffer-positions nil + "Cache of positions associated with package history. +These are stored in a hash table. See also +`apt-utils-package-history'") +(make-variable-buffer-local 'apt-utils-buffer-positions) + +(defvar apt-utils-dired-buffer nil + "Keep track of dired buffer.") + +(defvar apt-utils-automatic-update-asked nil + "Non-nil if user already asked about updating package lists.") + +(defvar apt-utils-timestamped-file "/var/cache/apt/pkgcache.bin" + "File to check timestamp of (see `apt-utils-automatic-update').") + +;; XEmacs support + +(defconst apt-utils-xemacs-p + (or (featurep 'xemacs) + (string-match "XEmacs\\|Lucid" (emacs-version))) + "True if we are using apt-utils under XEmacs.") + +;; Other version-dependent configuration + +(defalias 'apt-utils-line-end-position + (cond + ((fboundp 'line-end-position) 'line-end-position) + ((fboundp 'point-at-eol) 'point-at-eol))) + +(defalias 'apt-utils-line-beginning-position + (cond + ((fboundp 'line-beginning-position) 'line-beginning-position) + ((fboundp 'point-at-bol) 'point-at-bol))) + +(defconst apt-utils-completing-read-hashtable-p + ;; I think this is a valid way to check this feature... + (condition-case nil + (or (all-completions "" (make-hash-table)) t) + (error nil)) + "Non-nil if `completing-read' supports hash table as input.") + +(defconst apt-utils-face-property + (if (with-temp-buffer + ;; We have to rename to something without a leading space, + ;; otherwise font-lock-mode won't get activated. + (rename-buffer "*test-font-lock*") + (font-lock-mode 1) + (and (boundp 'char-property-alias-alist) + (member 'font-lock-face + (assoc 'face char-property-alias-alist)))) + 'font-lock-face + 'face) + "Use font-lock-face if `add-text-properties' supports it. +Otherwise, just use face.") + +(cond + ;; Emacs 21 + ((fboundp 'replace-regexp-in-string) + (defalias 'apt-utils-replace-regexp-in-string 'replace-regexp-in-string)) + ;; Emacs 20 + ((and (require 'dired) + (fboundp 'dired-replace-in-string)) + (defalias 'apt-utils-replace-regexp-in-string 'dired-replace-in-string)) + ;; XEmacs + ((fboundp 'replace-in-string) + (defun apt-utils-replace-regexp-in-string (regexp rep string) + (replace-in-string string regexp rep))) + ;; Bail out + (t + (error "No replace in string function found"))) + +;; Commands and functions + +;;;###autoload +(defun apt-utils-show-package (&optional new-session) + "Show information for a Debian package. +A selection of known packages is presented. See `apt-utils-mode' +for more detailed help. If NEW-SESSION is non-nil, generate a +new `apt-utils-mode' buffer." + (interactive "P") + (let ((package (apt-utils-choose-package))) + (when (> (length package) 0) + (apt-utils-show-package-1 package t new-session)))) + +(defun apt-utils-show-package-1 (package-spec &optional interactive new-session) + "Present Debian package information in a dedicated buffer. + +PACKAGE-SPEC can be either a string (the name of the package) or +a list, where the car of the list is the name of the package, and +the cdr is the package type. + +If INTERACTIVE is non-nil, then we have been called +interactively (or from a keyboard macro) via +`apt-utils-show-package'. Hence, reset the history of visited +packages. + +If NEW-SESSION is non-nil, generate a new `apt-utils-mode' +buffer." + (apt-utils-check-package-lists) + (let (package type) + (cond ((and package-spec (listp package-spec)) + (setq package (car package-spec)) + (setq type (cdr package-spec))) + ((stringp package-spec) + (setq package package-spec + type (apt-utils-package-type package)))) + ;; Set up the buffer + (cond + (new-session + (set-buffer (generate-new-buffer "*APT package info*")) + (apt-utils-mode) + (apt-utils-update-mode-name)) + ((eq major-mode 'apt-utils-mode) + ;; do nothing + ) + (t + (set-buffer (get-buffer-create "*APT package info*")) + (apt-utils-mode))) + ;; If called interactively, initialize apt-utils-package-history + (when (or interactive new-session) + (setq apt-utils-package-history (cons (cons package type) nil)) + (if (hash-table-p apt-utils-buffer-positions) + (clrhash apt-utils-buffer-positions) + (setq apt-utils-buffer-positions (make-hash-table :test 'equal)))) + (let ((inhibit-read-only t)) + (erase-buffer) + (cond + ((memq type '(normal normal-installed)) + (call-process apt-utils-apt-cache-program nil '(t nil) nil "show" package) + ;; Remove old versions if not wanted + (unless apt-utils-show-all-versions + (goto-char (point-min)) + (re-search-forward "^$") + (unless (eobp) + (delete-region (point) (point-max)))) + (apt-utils-add-package-links)) + ;; Virtual package or normal package w/ showpkg + ((memq type '(virtual normal-showpkg)) + (call-process apt-utils-apt-cache-program nil '(t nil) nil "showpkg" package) + (apt-utils-add-showpkg-links package)) + ;; Normal search + ((equal type 'search) + (insert (format "Debian package search for %s\n\n" package)) + (apply 'call-process apt-utils-apt-cache-program nil '(t nil) nil + "search" "--" + (split-string package apt-utils-search-split-regexp)) + (apt-utils-sort-result) + (apt-utils-add-search-links 'search)) + ;; Search for names only + ((equal type 'search-names-only) + (insert (format "Debian package search (names only) for %s\n\n" package)) + (apply 'call-process apt-utils-apt-cache-program nil '(t nil) nil + "search" "--names-only" "--" + (split-string package apt-utils-search-split-regexp)) + (apt-utils-sort-result) + (apt-utils-add-search-links 'search-names-only)) + ;; Search for file names + ((equal type 'search-file-names) + (insert (format "Debian package search (file names) for %s\n\n" package)) + (apply 'call-process apt-utils-dpkg-program nil t nil + "-S" (list package)) + (apt-utils-sort-result) + (apt-utils-add-search-links 'search-file-names)) + ;; grep-dctrl search + ((equal type 'search-grep-dctrl) + (insert (format "grep-dctrl search for %s\n\n" + (concat (format "\"%s\" " (car package)) + (mapconcat 'identity (cdr package) " ")))) + (apply 'call-process apt-utils-grep-dctrl-program nil t nil package) + (apt-utils-sort-result) + ;; Don't check installed status; may take forever + (let ((apt-utils-display-installed-status nil)) + (apt-utils-add-package-links)))) + (if apt-utils-use-current-window + (switch-to-buffer (current-buffer)) + (select-window (display-buffer (current-buffer)))) + ;; Point only needs setting for new sessions or when choosing + ;; new packages with apt-utils-follow-link or + ;; apt-utils-choose-package-link. + (goto-char (point-min)) + (run-hooks 'apt-utils-show-package-hooks))) + (set-buffer-modified-p nil) + (setq buffer-read-only t)) + +(defun apt-utils-list-package-files () + "List the files associated with the current package. +The list appears in a `dired-mode' buffer. Only works for +installed packages; uses `apt-utils-dpkg-program'." + (interactive) + (let ((package (caar apt-utils-package-history)) + (type (cdar apt-utils-package-history)) + files) + (setq files (apt-utils-get-package-files package)) + ;; Some meta packages contain only directories, so + ;; apt-utils-get-package-files returns '("/."); however, we don't + ;; want to list /. + (when (equal files '("/.")) + (setq files nil)) + (cond + ((memq type '(normal normal-showpkg normal-installed)) + (if files + (progn + ;; Some versions of Emacs won't update dired for the same + ;; directory name if it already exists + (if (buffer-live-p apt-utils-dired-buffer) + (kill-buffer apt-utils-dired-buffer)) + (setq apt-utils-dired-buffer (dired-noselect files)) + (display-buffer apt-utils-dired-buffer)) + (message "Package does not contain any files/is not installed."))) + (t + (message "No files associated for type: %s." type))))) + +(defalias 'apt-utils-view-package-files 'apt-utils-list-package-files) + +(defun apt-utils-get-package-files (package &optional filter installed) + "Return a list of files belonging to package PACKAGE. +With optional argument FILTER, return files matching this regular +expression. + +With non-nil INSTALLED, return t if package is installed, +otherwise nil." + (let (files) + (catch 'installed + (with-temp-buffer + (call-process apt-utils-dpkg-program nil t nil "-L" package) + ;; Check for files + (cond + ((or (search-backward "does not contain any files" nil t) + (search-backward "not installed" nil t) + ;; dlocate returns nothing for uninstalled packages + (or (zerop (buffer-size)))) + (when installed + (throw 'installed nil))) + (installed + (throw 'installed t)) + (t + (setq files (split-string (buffer-string) "\n")) + ;; Keep regular files or top directory (for dired) + (setq files + (delq nil + (mapcar (lambda (elt) + (if (and (or (file-regular-p elt) + (string-equal "/." elt)) + (string-match (or filter ".") elt)) + elt + nil)) + files)))))) + files))) + +(defun apt-utils-current-package-installed-p () + "Return non-nil if the current-package is installed." + (apt-utils-get-package-files (caar apt-utils-package-history) nil t)) + +;;;###autoload +(defun apt-utils-search () + "Search Debian packages for regular expression. +To search for multiple patterns use a string like \"foo && bar\". +The regular expression used to split the +terms (`apt-utils-search-split-regexp') is customisable." + (interactive) + (apt-utils-search-internal 'search + "Search packages for regexp: ")) + +(defun apt-utils-search-names-only () + "Search Debian package names for regular expression. +To search for multiple patterns use a string like \"foo && bar\". +The regular expression used to split the +terms (`apt-utils-search-split-regexp') is customisable." + (interactive) + (apt-utils-search-internal 'search-names-only + "Search package names for regexp: ")) + +(defun apt-utils-search-file-names () + "Search Debian file names for string." + (interactive) + (apt-utils-search-internal 'search-file-names + "Search file names for string: ")) + +(defun apt-utils-search-internal (type prompt) + "Search Debian packages for regular expression or string. +The type of search is specified by TYPE, the prompt for the +search is specified by PROMPT." + (apt-utils-check-package-lists) + (let ((regexp (read-from-minibuffer prompt))) + ;; Set up the buffer + (cond + ((eq major-mode 'apt-utils-mode) + ;; do nothing + ) + (t + (set-buffer (get-buffer-create "*APT package info*")) + (apt-utils-mode))) + (let ((inhibit-read-only t) + result) + (erase-buffer) + ;; Can't search for string starting with "-" because the "--" + ;; option isn't understood by dpkg or dlocate + (when (and (eq type 'search-file-names) + (string-match "^-" regexp)) + (setq regexp (apt-utils-replace-regexp-in-string "^-+" "" regexp))) + (insert (format "Debian package search%s for %s\n\n" + (cond ((eq type 'search-names-only) " (names only)") + ((eq type 'search-file-names) " (file names)") + (t "")) + regexp)) + (setq result + (cond + ((eq type 'search) + (setq apt-utils-package-history (cons (cons regexp 'search) nil)) + (apply 'call-process apt-utils-apt-cache-program nil '(t nil) nil + "search" "--" + (split-string regexp apt-utils-search-split-regexp))) + ((eq type 'search-names-only) + (setq apt-utils-package-history (cons (cons regexp 'search-names-only) nil)) + (apply 'call-process apt-utils-apt-cache-program nil '(t nil) nil + "search" "--names-only" "--" + (split-string regexp apt-utils-search-split-regexp))) + + ((eq type 'search-file-names) + (setq apt-utils-package-history (cons (cons regexp 'search-file-names) nil)) + (apply 'call-process apt-utils-dpkg-program nil t nil + "-S" (list regexp))))) + (if (hash-table-p apt-utils-buffer-positions) + (clrhash apt-utils-buffer-positions) + (setq apt-utils-buffer-positions (make-hash-table :test 'equal))) + (if (eq result 0) + (apt-utils-add-search-links type) + (if (hash-table-p apt-utils-current-links) + (clrhash apt-utils-current-links))) + (goto-char (point-min)) + ;; Sort results + (apt-utils-sort-result) + (set-buffer-modified-p nil) + (setq buffer-read-only t) + (display-buffer (current-buffer))))) + +(defun apt-utils-search-grep-dctrl () + "Search Debian packages for regular expression using grep-dctrl." + (interactive) + (apt-utils-check-package-lists) + (let (args + (fields (apt-utils-read-fields "Search package fields: ")) + (show (apt-utils-read-fields "Show package fields: ")) + (regexp (read-from-minibuffer "Search regexp: "))) + ;; Check args + (cond + ((equal (length fields) 0) + (error "No fields selected for search")) + ((equal (length show) 0) + (error "No fields selected for show")) + ((equal (length regexp) 0) + (error "No regexp selected"))) + (setq fields (concat "-F" fields)) + (setq show (concat "-s" show)) + (cond + ((eq major-mode 'apt-utils-mode) + ;; do nothing + ) + (t + (set-buffer (get-buffer-create "*APT package info*")) + (apt-utils-mode))) + (let ((inhibit-read-only t) + result) + (erase-buffer) + ;; Construct argument list (need to keep this) + (setq args (append (list regexp fields show) apt-utils-grep-dctrl-args + (or apt-utils-grep-dctrl-file-list + (directory-files apt-utils-grep-dctrl-file-directory + t "_Packages$")))) + (insert (format "grep-dctrl search for %s\n\n" + (mapconcat + (lambda (elt) + (if (string-equal regexp elt) + (format "\"%s\"" regexp) + elt)) + args " "))) + (setq result + (apply 'call-process + apt-utils-grep-dctrl-program nil t nil args)) + (setq apt-utils-package-history (cons (cons args 'search-grep-dctrl) nil)) + (if (hash-table-p apt-utils-buffer-positions) + (clrhash apt-utils-buffer-positions) + (setq apt-utils-buffer-positions (make-hash-table :test 'equal))) + (if (eq result 0) + (apt-utils-add-package-links) + (if (hash-table-p apt-utils-current-links) + (clrhash apt-utils-current-links))) + (goto-char (point-min)) + (set-buffer-modified-p nil) + (setq buffer-read-only t) + (display-buffer (current-buffer))))) + +(defun apt-utils-read-fields (prompt) + "Read fields for `apt-utils-search-grep-dctrl'. +Use PROMPT for `completing-read'." + (let ((chosen "foo") + (completion-ignore-case t) + ;; Why can't I use '(...) for the list? + (keywords (list "Architecture" "Bugs" "Conffiles" "Conflicts" + "Depends" "Description" "Enhances" "Essential" + "Filename" "Installed-Size" "MD5sum" "Maintainer" + "Origin" "Package" "Pre-Depends" "Priority" + "Provides" "Recommends" "Replaces" "Section" + "Size" "Source" "Suggests" "Tag" "Task" "Version" + "url")) + fields) + (while (> (length chosen) 0) + (setq chosen + (completing-read prompt + (mapcar (lambda (elt) + (list elt elt)) + keywords) + nil + t)) + (setq keywords (delete chosen keywords)) + (if (stringp fields) + (progn + (when (> (length chosen) 0) + (setq fields (concat fields "," chosen)))) + (setq fields chosen))) + fields)) + +(defun apt-utils-toggle-package-info () + "Toggle between package and showpkg info for normal packages." + (interactive) + (unless (equal major-mode 'apt-utils-mode) + (error "Not in APT utils buffer")) + (let ((package (caar apt-utils-package-history)) + (type (cdar apt-utils-package-history)) + posns) + (cond + ((memq type '(normal normal-installed)) + (setq posns (apt-utils-update-buffer-positions 'toggle)) + (setq apt-utils-package-history + (cons (cons package 'normal-showpkg) + (cdr apt-utils-package-history))) + (apt-utils-show-package-1 (car apt-utils-package-history) nil) + (goto-char (car posns)) + (set-window-start (selected-window) (cadr posns))) + ((equal type 'normal-showpkg) + (setq posns (apt-utils-update-buffer-positions 'toggle)) + (setq apt-utils-package-history + (cons (cons package 'normal) + (cdr apt-utils-package-history))) + (apt-utils-show-package-1 (car apt-utils-package-history) nil) + (goto-char (car posns)) + (set-window-start (selected-window) (cadr posns))) + ((equal type 'virtual) + (message "Cannot toggle info for virtual packages.")) + ((memq type '(search search-names-only + search-file-names + search-grep-dctrl)) + (message "Cannot toggle info for searches."))))) + +(defun apt-utils-normal-package-p () + "Return non-nil if the current package is a normal package. +That is, not a normal-showpkg, search or a virtual package." + (eq (cdar apt-utils-package-history) 'normal)) + +(defun apt-utils-toggle-package-p () + "Return non-nil if we can toggle between package and showpkg. +See also `apt-utils-toggle-package-info'." + (memq (cdar apt-utils-package-history) '(normal normal-showpkg normal-installed))) + +(defun apt-utils-check-package-lists () + "Determine whether package lists need rebuilding." + (apt-utils-update-mode-name) + (cond + ((null apt-utils-package-list-built) + (apt-utils-build-package-list)) + ((and (apt-utils-packages-needs-update) + ;; Only act for non-nil apt-utils-automatic-update + apt-utils-automatic-update + (cond + ((eq apt-utils-automatic-update t)) + ((eq apt-utils-automatic-update 'ask) + (unless apt-utils-automatic-update-asked + (setq apt-utils-automatic-update-asked t) + (yes-or-no-p + "APT package lists may be out of date. Update them? "))))) + (apt-utils-build-package-list t)))) + +;; Find ChangeLog files + +(defun apt-utils-view-changelog () + "Find ChangeLog for the current package." + (interactive) + (cond + ((not (equal major-mode 'apt-utils-mode)) + (message "Not in APT utils buffer.")) + ((not (memq (cdar apt-utils-package-history) '(normal normal-showpkg normal-installed))) + (message "Not a normal package.")) + (t + (let* ((package (caar apt-utils-package-history)) + (file (apt-utils-changelog-file package))) + (if file + (apt-utils-view-file file) + (message "No ChangeLog file found for %s." package)))))) + +(defun apt-utils-changelog-file (&optional package) + "Find ChangeLog file for PACKAGE or the current package." + (unless package (setq package (caar apt-utils-package-history))) + (let ((file + (apt-utils-find-readable-file + (format "/usr/share/doc/%s/" package) + '("CHANGELOG" "ChangeLog" "Changelog" "changelog") + '("" ".gz")))) + file)) + +;; Find Debian ChangeLog files + +(defun apt-utils-view-debian-changelog () + "Find Debian ChangeLog for the current package." + (interactive) + (cond + ((not (equal major-mode 'apt-utils-mode)) + (message "Not in APT utils buffer.")) + ((not (memq (cdar apt-utils-package-history) '(normal normal-showpkg normal-installed))) + (message "Not a normal package.")) + (t + (let* ((package (caar apt-utils-package-history)) + (file (apt-utils-debian-changelog-file package))) + (if file + (apt-utils-view-file file) + (message "No Debian ChangeLog file found for %s." package)))))) + +(defun apt-utils-debian-changelog-file (&optional package) + "Find Debian ChangeLog file for PACKAGE or the current package." + (unless package (setq package (caar apt-utils-package-history))) + (let ((file + (apt-utils-find-readable-file + (format "/usr/share/doc/%s/" package) + '("changelog.Debian") + '(".gz")))) + file)) + +;; Find NEWS files + +(defun apt-utils-view-news () + "Find NEWS for the current package." + (interactive) + (cond + ((not (equal major-mode 'apt-utils-mode)) + (message "Not in APT utils buffer.")) + ((not (memq (cdar apt-utils-package-history) '(normal normal-showpkg normal-installed))) + (message "Not a normal package.")) + (t + (let* ((package (caar apt-utils-package-history)) + (file (apt-utils-news-file package))) + (if file + (apt-utils-view-file file) + (message "No NEWS file found for %s." package)))))) + +(defun apt-utils-news-file (&optional package) + "Find NEWS file for PACKAGE or the current package." + (unless package (setq package (caar apt-utils-package-history))) + (let ((file + (apt-utils-find-readable-file + (format "/usr/share/doc/%s/" package) + '("NEWS") + '("" ".gz")))) + file)) + +;; Find Debian NEWS files + +(defun apt-utils-view-debian-news () + "Find Debian NEWS for the current package." + (interactive) + (cond + ((not (equal major-mode 'apt-utils-mode)) + (message "Not in APT utils buffer.")) + ((not (memq (cdar apt-utils-package-history) '(normal normal-showpkg normal-installed))) + (message "Not a normal package.")) + (t + (let* ((package (caar apt-utils-package-history)) + (file (apt-utils-debian-news-file package))) + (if file + (apt-utils-view-file file) + (message "No Debian NEWS file found for %s." package)))))) + +(defun apt-utils-debian-news-file (&optional package) + "Find Debian NEWS file for PACKAGE or the current package." + (unless package (setq package (caar apt-utils-package-history))) + (let ((file + (apt-utils-find-readable-file + (format "/usr/share/doc/%s/" package) + '("NEWS.Debian") + '(".gz")))) + file)) + +;; Find README files + +(defun apt-utils-view-readme () + "Find README for the current package." + (interactive) + (cond + ((not (equal major-mode 'apt-utils-mode)) + (message "Not in APT utils buffer.")) + ((not (memq (cdar apt-utils-package-history) '(normal normal-showpkg normal-installed))) + (message "Not a normal package.")) + (t + (let* ((package (caar apt-utils-package-history)) + (file (apt-utils-readme-file package))) + (if file + (apt-utils-view-file file) + (message "No README file found for %s." package)))))) + +(defun apt-utils-readme-file (&optional package) + "Find README file for PACKAGE or the current package." + (unless package (setq package (caar apt-utils-package-history))) + (let ((file + (apt-utils-find-readable-file + (format "/usr/share/doc/%s/" package) + '("README" "readme") + '("" ".gz")))) + file)) + +;; Find Debian README files + +(defun apt-utils-view-debian-readme () + "Find Debian README for the current package." + (interactive) + (cond + ((not (equal major-mode 'apt-utils-mode)) + (message "Not in APT utils buffer.")) + ((not (memq (cdar apt-utils-package-history) '(normal normal-showpkg normal-installed))) + (message "Not a normal package.")) + (t + (let* ((package (caar apt-utils-package-history)) + (file (apt-utils-debian-readme-file package))) + (if file + (apt-utils-view-file file) + (message "No Debian README file found for %s." package)))))) + +(defun apt-utils-debian-readme-file (&optional package) + "Find Debian README file for PACKAGE or the current package." + (unless package (setq package (caar apt-utils-package-history))) + (let ((file + (apt-utils-find-readable-file + (format "/usr/share/doc/%s/" package) + '("README.Debian" "README.debian") + '("" ".gz")))) + file)) + +;; Find copyright files + +(defun apt-utils-view-copyright () + "Find copyright file for the current package." + (interactive) + (cond + ((not (equal major-mode 'apt-utils-mode)) + (message "Not in APT utils buffer.")) + ((not (memq (cdar apt-utils-package-history) '(normal normal-showpkg normal-installed))) + (message "Not a normal package.")) + (t + (let* ((package (caar apt-utils-package-history)) + (file (apt-utils-copyright-file package))) + (if file + (apt-utils-view-file file) + (message "No copyright file found for %s." package)))))) + +(defun apt-utils-copyright-file (&optional package) + "Find copyright file for PACKAGE or the current package." + (unless package (setq package (caar apt-utils-package-history))) + (let ((file + (apt-utils-find-readable-file + (format "/usr/share/doc/%s/copyright" package) + '("") + '("")))) + file)) + +(defun apt-utils-view-man-page () + "View man page for the current package. +If there is more than one man page associated with the package, +offer a choice." + (interactive) + (cond + ((not (equal major-mode 'apt-utils-mode)) + (message "Not in APT utils buffer.")) + ((not (memq (cdar apt-utils-package-history) '(normal normal-showpkg normal-installed))) + (message "Not a normal package.")) + (t + (let ((package (caar apt-utils-package-history)) + (regexp + "^.*/man/\\([a-zA-Z_/.]+\\)?man[0-9]/\\(.*\\)\\.\\([0-9a-z]+\\)\\.gz") + choice chosen files table) + (setq files (apt-utils-get-package-files package + "/man/.*\\.gz$")) + (cond + ((null files) + (message "No man pages found for %s." package)) + ((not (cdr files)) + (setq chosen (car files))) + (t + (setq table (mapcar + (lambda (file) + (setq choice + (with-temp-buffer + (insert file) + (when (re-search-backward regexp nil t) + (replace-match "\\2 (\\1\\3)" nil nil)) + (buffer-string))) + (cons choice file)) + files)) + (setq chosen + (cdr (assoc + (let ((completion-ignore-case t)) + (completing-read "Choose man page: " table nil t)) + table))))) + (when chosen + (if (fboundp 'woman-find-file) + (woman-find-file chosen) + (manual-entry chosen))))))) + +(defun apt-utils-view-emacs-startup-file () + "View Emacs startup file for the current package. +If there is more than one file associated with the package, offer +a choice." + (interactive) + (cond + ((not (equal major-mode 'apt-utils-mode)) + (message "Not in APT utils buffer.")) + ((not (memq (cdar apt-utils-package-history) '(normal normal-showpkg normal-installed))) + (message "Not a normal package.")) + (t + (let ((package (caar apt-utils-package-history)) + chosen files table) + (setq files + (or (apt-utils-get-package-files package + "^/etc/emacs/site-start.d/.*") + (and (boundp 'debian-emacs-flavor) + (apt-utils-get-package-files + package + (format "^/etc/%s/site-start.d/.*" + (symbol-name debian-emacs-flavor)))))) + (cond + ((null files) + (message "No Emacs startup files found for %s." package)) + ((not (cdr files)) + (setq chosen (car files))) + (t + (setq table (mapcar + (lambda (file) + (cons file file)) + files)) + (setq chosen + (cdr (assoc + (let ((completion-ignore-case t)) + (completing-read "Choose Emacs startup file: " table nil t)) + table))))) + (when chosen + (apt-utils-view-file chosen)))))) + +(defun apt-utils-view-version () + "View installed version information for current package." + (interactive) + (let ((package (caar apt-utils-package-history)) + (type (cdar apt-utils-package-history))) + (if (memq type '(normal normal-showpkg normal-installed)) + (let ((info (apt-utils-get-installed-info package))) + (if info + (message (apply #'format + "%s: version %s (Desired = %s; Status = %s; Error = %s)" + package info)) + (message "Not installed; not known to dkpg"))) + (message "Can show version info only for normal packages")))) + +(defun apt-utils-get-installed-info (package) + "Return list of installation information for package PACKAGE." + (let ((desired-list '((?u "Unknown") + (?i "Install") + (?r "Remove") + (?p "Purge") + (?h "Hold"))) + (status-list '((?n "Not installed") + (?i "Installed") + (?c "Config files") + (?u "Unpackage") + (?f "Failed config") + (?h "Half installed"))) + (err-list '((? "None") + (?h "Hold") + (?r "Reinstall required") + (?x "Hold + reinstall required"))) + desired status err status-bad err-bad) + (unless (eq package 'broken) + (with-temp-buffer + (let ((process-environment (append '("COLUMNS=200") (copy-alist process-environment)))) + (call-process apt-utils-dpkg-program nil t nil "-l" package)) + (when (re-search-backward + (format "^\\([a-z ][a-z ][a-z ]\\)\\s-+%s\\s-+\\(\\S-+\\)" + (regexp-quote package)) nil t) + (progn + (setq desired (aref (match-string 1) 0) + status (aref (match-string 1) 1) + err (aref (match-string 1) 2) + status-bad (not (eq status (downcase status))) + err-bad (not (eq err (downcase err)))) + ;; Return list of information + (list (match-string 2) ; version + (cadr (assoc desired desired-list)) + (concat (cadr (assoc (downcase status) status-list)) + (and status-bad " [bad]")) + (concat (cadr (assoc (downcase err) err-list)) + (and err-bad " [bad]"))))))))) + +(defun apt-utils-insert-installed-info (package) + "Insert installed information for package PACKAGE at point." + (let ((posn (point))) + (insert (format " (%s)" (or (nth 2 (apt-utils-get-installed-info package)) + "Not installed; not known to dpkg"))) + (add-text-properties (1+ posn) + (point) + '(face apt-utils-installed-status-face)))) + +;; File-related utility functions + +(defun apt-utils-find-readable-file (dir prefixes suffixes) + "Find a readable file composed of directory prefix and suffix. +Directory is DIR, prefix is one of PREFIXES and suffix is one of +SUFFIXES." + (catch 'found + (dolist (prefix prefixes) + (dolist (suffix suffixes) + (when (file-readable-p (concat dir prefix suffix)) + (throw 'found (concat dir prefix suffix))))) + nil)) ; Return nil, if no file found + +(defun apt-utils-view-file (file) + "View file FILE in function `view-mode'." + (cond ((string-match "\\.gz$" file) + (if (fboundp 'with-auto-compression-mode) + (with-auto-compression-mode + (view-file file)) + (auto-compression-mode 1) + (view-file file))) + (t + (view-file file)))) + +;; Follow hyperlinks + +(defun apt-utils-follow-link (new-session) + "Follow hyperlink at point. +With non-nil NEW-SESSION, follow link in a new buffer." + (interactive "P") + (unless (equal major-mode 'apt-utils-mode) + (error "Not in APT utils buffer")) + (let ((package + (cadr + (member 'apt-package (text-properties-at (point)))))) + (apt-utils-follow-link-internal package new-session))) + +(defun apt-utils-mouse-follow-link (event) + "Follow hyperlink at mouse click. +Argument EVENT is a mouse event." + (interactive "e") + (let (package) + (save-selected-window + (mouse-set-point event) + (setq package (apt-utils-package-at-point)) + (apt-utils-follow-link-internal package nil)))) + +(defun apt-utils-package-at-point () + "Return name of package at point, if any." + (cadr + (member 'apt-package (text-properties-at + (point))))) + +(defun apt-utils-follow-link-internal (package new-session) + "Follow hyperlink for PACKAGE. +With non-nil NEW-SESSION, follow link in a new buffer." + (cond + ((equal package 'broken) + (message "Package name is broken somehow.")) + (package + (unless new-session + (apt-utils-update-buffer-positions 'forward)) + (apt-utils-show-package-1 package nil new-session) + (unless new-session + (setq apt-utils-package-history + (cons (cons package (apt-utils-package-type package)) + apt-utils-package-history)))) + (t + (message "No known package at point.")))) + +;; Go to previous package in list + +(defun apt-utils-view-previous-package () + "Go back to previous package displayed." + (interactive) + (unless (equal major-mode 'apt-utils-mode) + (error "Not in APT utils buffer")) + (if (cdr apt-utils-package-history) + (progn + (let ((posns (apt-utils-update-buffer-positions 'backward))) + (apt-utils-show-package-1 (cadr apt-utils-package-history) nil) + (goto-char (car posns)) + (set-window-start (selected-window) (cadr posns))) + (setq apt-utils-package-history (cdr apt-utils-package-history))) + (message "No further package history."))) + +(defun apt-utils-previous-package-p () + "Return non-nil if there is a previous entry in the package history. +See also `apt-utils-package-history'." + (cdr apt-utils-package-history)) + +;; Adapted from widget-move + +(defun apt-utils-next-package (&optional arg) + "Move point to the ARG next package. +ARG may be negative to move backward." + (interactive "p") + (unless (equal major-mode 'apt-utils-mode) + (error "Not in APT utils buffer")) + (cond + ;; No links + ((or (null apt-utils-current-links) + (= (hash-table-count apt-utils-current-links) 0)) + (message "No package links.")) + ;; One link + ((and (= (hash-table-count apt-utils-current-links) 1) + (not (eq (cdar apt-utils-package-history) 'search-file-names))) + (goto-char (point-min)) + (goto-char (next-single-property-change (point) + 'apt-package))) + (t + (let ((old (apt-utils-package-at))) + ;; Forward. + (while (> arg 0) + (cond ((eobp) + (goto-char (point-min))) + (t + (goto-char (or (next-single-property-change + (point) 'apt-package) + (point-max))))) + (let ((new (apt-utils-package-at))) + (when new + (unless (eq new old) + (setq arg (1- arg)) + (setq old new))))) + ;; Backward. + (while (< arg 0) + (cond ((bobp) + (goto-char (point-max))) + (t + (goto-char (or (previous-single-property-change + (point) 'apt-package) + (point-min))))) + (let ((new (apt-utils-package-at))) + (when new + (unless (eq new old) + (setq arg (1+ arg)))))) + ;; Go to beginning of field. + (let ((new (apt-utils-package-at))) + (while (eq (apt-utils-package-at) new) + (backward-char))) + (forward-char)))) + ;; Echo some info + (when apt-utils-show-link-info + (apt-utils-package-at-message))) + +(defun apt-utils-previous-package (&optional arg) + "Move point to the ARG previous package. +ARG may be negative to move forward." + (interactive "p") + (apt-utils-next-package (- arg))) + +;; Choose a package from the known links + +(defun apt-utils-choose-package-link (new-session) + "Choose a Debian package from a list of links. +With non-nil NEW-SESSION, follow link in a new buffer." + (interactive "P") + (apt-utils-choose-package-link-internal new-session)) + +(defun apt-utils-choose-package-link-internal (new-session) + "Choose a Debian package from a list of links. +With non-nil NEW-SESSION, follow link in a new buffer." + (cond + ((not (equal major-mode 'apt-utils-mode)) + (error "Not in APT utils buffer")) + ((= (hash-table-count apt-utils-current-links) 0) + (message "No package links.")) + (t + (let* ((PC-word-delimiters "-") + (package + (completing-read "Choose related Debian package: " + (cond + (apt-utils-completing-read-hashtable-p + apt-utils-current-links) + (t + (apt-utils-build-completion-table + apt-utils-current-links))) + nil t))) + (when (> (length package) 0) + (unless new-session + (apt-utils-update-buffer-positions 'forward)) + (apt-utils-show-package-1 package nil new-session) + (unless new-session + (setq apt-utils-package-history + (cons (cons package (apt-utils-package-type package)) + apt-utils-package-history)))))))) + +(defun apt-utils-build-package-list (&optional force) + "Build list of Debian packages known to APT. +With optional argument FORCE, rebuild the packages lists even if +they are defined. When package lists are not up-to-date, this is +indicated in `mode-name'." + (when (or force (null apt-utils-package-list-built)) + (unwind-protect + (progn + (setq apt-utils-package-list-built nil + apt-utils-automatic-update-asked nil) + (message "Building Debian package lists...") + ;; Hash table listing package types + (if (hash-table-p apt-utils-package-list) + (clrhash apt-utils-package-list) + (setq apt-utils-package-list (make-hash-table :test 'equal))) + ;; All packages except virtual ones + (with-temp-buffer + ;; Virtual and normal packages + (call-process apt-utils-apt-cache-program nil '(t nil) nil "pkgnames") + (goto-char (point-min)) + (while (not (eobp)) + (apt-utils-puthash (buffer-substring (apt-utils-line-beginning-position) + (apt-utils-line-end-position)) + 'virtual apt-utils-package-list) + (forward-line 1)) + ;; Normal packages + (erase-buffer) + (call-process apt-utils-apt-cache-program nil '(t nil) nil "pkgnames" + "-o" "APT::Cache::AllNames=0") + (goto-char (point-min)) + (while (not (eobp)) + (apt-utils-puthash (buffer-substring (apt-utils-line-beginning-position) + (apt-utils-line-end-position)) + 'normal apt-utils-package-list) + (forward-line 1)) + ;; Installed packages + (erase-buffer) + (call-process apt-utils-dpkg-program nil t nil "-l") + (goto-char (point-min)) + (let (package) + (while (not (eobp)) + (when (looking-at "^ii") + (setq package + (nth 1 (split-string (buffer-substring + (apt-utils-line-beginning-position) + (apt-utils-line-end-position)) + "\\s-+"))) + (apt-utils-puthash package + 'normal-installed + apt-utils-package-list)) + (forward-line 1)))) + (message "Building Debian package lists...done.") + (setq apt-utils-package-list-built (current-time)) + (apt-utils-update-mode-name)) + (unless apt-utils-package-list-built + (message "Building Debian package lists...interrupted.") + (apt-utils-update-mode-name) + (if (hash-table-p apt-utils-package-list) + (clrhash apt-utils-package-list)))))) + +(defun apt-utils-rebuild-package-lists () + "Rebuild the APT package lists." + (interactive) + (apt-utils-build-package-list t)) + +(defun apt-utils-choose-package () + "Choose a Debian package name." + (let ((package + (and (eq major-mode 'apt-utils-mode) + (cadr (member 'apt-package + (text-properties-at (point)))))) + (PC-word-delimiters "-")) + (when (not (stringp package)) + (setq package (word-at-point))) + (completing-read (if package + (format "Choose Debian package (%s): " package) + "Choose Debian package: ") + 'apt-utils-choose-package-completion + nil t package))) + +;; emacs 22 has `dynamic-completion-table' to help construct a +;; function like this, but emacs 21 and xemacs 21) don't +(defun apt-utils-choose-package-completion (str pred all) + "Apt package name completion handler, for `completing-read'." + (let ((enable-recursive-minibuffers t)) + (apt-utils-check-package-lists)) + (cond ((null all) + (try-completion str (if apt-utils-completing-read-hashtable-p + apt-utils-package-list + (apt-utils-build-completion-table + apt-utils-package-list)) + pred)) + ((eq all t) + (all-completions str (if apt-utils-completing-read-hashtable-p + apt-utils-package-list + (apt-utils-build-completion-table + apt-utils-package-list)) + pred)) + ((eq all 'lambda) + (if (fboundp 'test-completion) + ;; `test-completion' is new in emacs22, and it takes + ;; hashtables, so don't really need to test + ;; apt-utils-completing-read-hashtable-p + (test-completion str (if apt-utils-completing-read-hashtable-p + apt-utils-package-list + (apt-utils-build-completion-table + apt-utils-package-list)) + pred) + (and (gethash str apt-utils-package-list) + t))))) + +(defun apt-utils-build-completion-table (hash) + "Build completion table for packages using keys of hashtable HASH." + (let (ret) + (maphash (lambda (key value) + (setq ret (cons (list key) ret))) + hash) + ret)) + +;; Add hyperlinks + +(defun apt-utils-add-package-links () + "Add hyperlinks to related Debian packages." + (let ((keywords '("Conflicts" "Depends" "Enhances" "Package" + "Pre-Depends" "Provides" "Recommends" "Replaces" + "Suggests")) + match) + (if (hash-table-p apt-utils-current-links) + (clrhash apt-utils-current-links) + (setq apt-utils-current-links (make-hash-table :test 'equal))) + (goto-char (point-min)) + (while (re-search-forward "^\\([^ \n:]+\\):\\( \\|$\\)" + (point-max) t) + (setq match (match-string 1)) + (add-text-properties (if (looking-at "$") + (point) ;; Conffiles (also see below) + (1- (point))) + (save-excursion + (beginning-of-line) + (point)) + `(,apt-utils-face-property apt-utils-field-keyword-face)) + (cond + ((member match keywords) + ;; Remove newline characters in field + (let ((end (apt-field-end-position))) + (subst-char-in-region (point) end ?\n ?\ ) + (canonically-space-region (point) end)) + ;; Find packages + (let ((packages (apt-utils-current-field-packages)) + (inhibit-read-only t) + face + length length-no-version + package) + (while packages + (setq package (car packages)) + (setq length (length package)) + ;; Remove version info (in parenthesis), and whitespace + (setq package (apt-utils-replace-regexp-in-string + "\\((.*)\\|\\s-+\\)" "" package)) + (setq length-no-version (length package)) + ;; Package type + (cond + ((equal (apt-utils-package-type package t) 'normal) + (setq face 'apt-utils-normal-package-face)) + ((equal (apt-utils-package-type package t) 'normal-installed) + (setq face 'apt-utils-normal-installed-package-face)) + ((equal (apt-utils-package-type package t) 'virtual) + (setq face 'apt-utils-virtual-package-face)) + (t + (setq face 'apt-utils-broken-face) + (setq package 'broken))) + ;; Store package links + (apt-utils-current-links-add-package package) + ;; Add text properties + (add-text-properties (point) (+ (point) length-no-version) + `(,apt-utils-face-property ,face + mouse-face highlight + apt-package ,package)) + ;; Version? + (when (> length length-no-version) + (add-text-properties (+ (point) length-no-version 1) + (+ (point) length) + `(,apt-utils-face-property apt-utils-version-face))) + ;; Fill package names + (when (and apt-utils-fill-packages + (> (current-column) (+ 2 (length match))) + (> (+ (current-column) length) fill-column)) + (when (equal (char-before) ?\ ) + (delete-char -1)) ; trailing whitespace + (insert "\n" (make-string (+ 2 (length match)) ? ))) + (forward-char length) + (when (and (equal match "Package") + apt-utils-display-installed-status) + (apt-utils-insert-installed-info package)) + (skip-chars-forward ", |\n") + (setq packages (cdr packages))))) + ((string-match-p "Description\\(-..\\)?" match) + (add-text-properties (point) + (save-excursion + (or + (re-search-forward "^[^ ]" (point-max) t) + (point-max))) + `(,apt-utils-face-property apt-utils-description-face))) + ;; Conffiles doesn't have trailing space + ((looking-at "$") + nil) + (t + (add-text-properties (1- (point)) + (save-excursion + (end-of-line) + (point)) + `(,apt-utils-face-property apt-utils-field-contents-face))))))) + +(defun apt-utils-add-showpkg-links (package) + "Add hyperlinks to related Debian packages for PACKAGE." + (let ((keywords '("Reverse Depends" "Reverse Provides")) + (inhibit-read-only t) + start end regexp face link) + (if (hash-table-p apt-utils-current-links) + (clrhash apt-utils-current-links) + (setq apt-utils-current-links (make-hash-table :test 'equal))) + (while keywords + (setq regexp (concat "^" (car keywords) ": ")) + (goto-char (point-min)) + (when (re-search-forward regexp (point-max) t) + (add-text-properties (match-beginning 0) (1- (match-end 0)) + `(,apt-utils-face-property + apt-utils-field-keyword-face)) + ;; Limits of search + (setq start (1+ (point))) + (setq end (or (re-search-forward "[a-z]:" (point-max) t) + (point-max))) + (save-restriction + (narrow-to-region start end) + (goto-char (point-min)) + (while (not (eobp)) + (when (or (looking-at "^\\s-+\\(.*\\),") + (looking-at "^\\(.*\\) ")) + (setq link (match-string 1)) + (cond + ((equal (apt-utils-package-type link t) 'normal) + (setq face 'apt-utils-normal-package-face)) + ((equal (apt-utils-package-type package t) 'normal-installed) + (setq face 'apt-utils-normal-installed-package-face)) + ((equal (apt-utils-package-type link t) 'virtual) + (setq face 'apt-utils-virtual-package-face)) + (t + (setq face 'apt-utils-broken-face) + (setq link 'broken))) + ;; Store package links + (apt-utils-current-links-add-package link) + (add-text-properties (match-beginning 1) (match-end 1) + `(,apt-utils-face-property ,face + mouse-face highlight + apt-package ,link))) + (forward-line)))) + (setq keywords (cdr keywords)))) + (when (and apt-utils-display-installed-status + (memq (apt-utils-package-type package t) + '(normal normal-installed))) + (goto-char (point-min)) + (re-search-forward "Package: .*$") + (apt-utils-insert-installed-info package))) + +(defun apt-utils-add-search-links (type) + "Add hyperlinks to related Debian packages. +The type of search is specified by TYPE." + (let ((inhibit-read-only t) + local-keymap + face link regexp) + (when (eq type 'search-file-names) + (setq local-keymap (make-sparse-keymap)) + (define-key local-keymap (kbd "RET") + (lambda () + (interactive) + (view-file (or (get-text-property (point) 'apt-package-file) + (get-text-property (1- (point)) 'apt-package-file)))))) + (if (hash-table-p apt-utils-current-links) + (clrhash apt-utils-current-links) + (setq apt-utils-current-links (make-hash-table :test 'equal))) + (goto-char (point-min)) + (forward-line 2) ; Move past header + (cond + ((eq type 'search-file-names) + ;; Reformat diversion information + (save-excursion + (while (re-search-forward "diversion by \\(.*\\) \\(from\\|to\\): \\(.*\\)" nil t) + (replace-match "\\1: \\3 (diversion \\2)" nil nil))) + (setq regexp "\\([^:,]+\\)[,:]")) + (t + (setq regexp"^\\([^ ]+\\) - "))) + (while (re-search-forward regexp (point-max) t) + (setq link (match-string 1)) + (cond + ((equal (apt-utils-package-type link t) 'normal) + (setq face 'apt-utils-normal-package-face)) + ((equal (apt-utils-package-type link t) 'normal-installed) + (setq face 'apt-utils-normal-installed-package-face)) + ((equal (apt-utils-package-type link t) 'virtual) + (setq face 'apt-utils-virtual-package-face)) + (t + (setq face 'apt-utils-broken-face) + (setq link 'broken))) + ;; Store package links + (apt-utils-current-links-add-package link) + (add-text-properties (match-beginning 1) (match-end 1) + `(,apt-utils-face-property ,face + mouse-face highlight + apt-package ,link)) + ;; Multiple fields separated by commas + (when (eq type 'search-file-names) + (if (eq (char-before) ?\:) + (progn + (when local-keymap + (let ((start (1+ (point))) + (end (save-excursion + (goto-char (apt-utils-line-end-position)) + (re-search-backward " (diversion \\(from\\|to\\))" + (apt-utils-line-beginning-position) + t) + (point)))) + (add-text-properties start end + `(face apt-utils-file-face + keymap ,local-keymap + ;; Pretend we're a package + ;; so that we can move + ;; here with + ;; apt-utils-next-package + apt-package dummy + apt-package-file + ,(buffer-substring-no-properties start end) + )))) + (goto-char (1+ (apt-utils-line-end-position)))) + (skip-chars-forward ", ")))))) + +(defun apt-utils-package-type (package &optional no-error) + "Return what type of package PACKAGE is. +With optional argument NO-ERROR, don't flag an error for unknown +packages." + (or (gethash package apt-utils-package-list) + (cond + (no-error + nil) + (t + (error + (substitute-command-keys + "Package name is broken: rebuild package lists using \\[apt-utils-rebuild-package-lists] may help") + package))))) + +(defun apt-utils-package-at () + "Get package at point." + (get-text-property (point) 'apt-package)) + +(defun apt-utils-package-at-message () + "Emit message describing package at point." + (let ((package (apt-utils-package-at))) + (cond + ((eq package 'dummy) + ;; Do nothing as this isn't really a package + ) + ((equal package 'broken) + (message "Package name is broken somehow.")) + (package + (with-temp-buffer + (call-process apt-utils-apt-cache-program nil t nil "show" package) + (if (re-search-backward "^Description: \\(.*\\)$" (point-min) t) + (message "%s: %s." package (match-string 1)) + (message "%s: virtual package (no description)." + package))))))) + +(defun apt-utils-quit (&optional kill-buffer) + "Quit this `apt-utils-mode' buffer. +With prefix argument KILL-BUFFER, kill the `apt-utils-mode' +buffer." + (interactive "P") + (unless (equal major-mode 'apt-utils-mode) + (error "Not in APT utils buffer")) + (let ((buffer (current-buffer))) + (if (fboundp 'quit-window) + (quit-window) + (bury-buffer)) + (when kill-buffer + (kill-buffer buffer))) + (run-hooks 'apt-utils-quit-hooks)) + +(defun apt-utils-cleanup () + "Clean up lists used by `apt-utils-mode'. +Specifically, nullify `apt-utils-package-list'. Only do this if +there are no buffers left in `apt-utils-mode'." + (unless (memq 'apt-utils-mode + (mapcar (lambda (b) + (with-current-buffer b + major-mode)) + (delete (current-buffer) (buffer-list)))) + (clrhash apt-utils-package-list) + (setq apt-utils-package-list-built nil))) + +(defun apt-utils-describe-package () + "Describe package at point." + (interactive) + (apt-utils-package-at-message)) + +(defun apt-utils-kill-other-window-buffers () + "Kill buffers in other windows and the windows themselves. +See `apt-utils-kill-buffer-confirmation-function' for +customisation options." + (interactive) + (cond + ((not (eq major-mode 'apt-utils-mode)) + (error "Not in APT utils buffer")) + ((not (cdr (window-list))) + (message "No other windows to kill")) + (t + (when (or (null apt-utils-kill-buffer-confirmation-function) + (funcall apt-utils-kill-buffer-confirmation-function + "Kill buffers in other windows? ")) + (let ((buffer-list + (delq (current-buffer) + (mapcar #'window-buffer (window-list))))) + (mapc (lambda (b) + (when (buffer-live-p b) + (kill-buffer b))) + buffer-list)) + (delete-other-windows)) + (message nil)))) + +;; Track positions + +(defun apt-utils-update-buffer-positions (type) + "Update `apt-utils-buffer-positions'. +TYPE can be forward, backward, or toggle." + (let (posns) + (cond + ((eq type 'forward) + ;; Make the key unique; we could visit the same package more + ;; than once + (apt-utils-puthash (format "%s/%s/%d" + (caar apt-utils-package-history) + (cdar apt-utils-package-history) + (length apt-utils-package-history)) + (list (point) (window-start (selected-window))) + apt-utils-buffer-positions)) + ((eq type 'backward) + ;; Remove old values + (remhash (format "%s/normal/%d" + (caar apt-utils-package-history) + (length apt-utils-package-history)) + apt-utils-buffer-positions) + (remhash (format "%s/normal-showpkg/%d" + (caar apt-utils-package-history) + (length apt-utils-package-history)) + apt-utils-buffer-positions) + (remhash (format "%s/virtual/%d" + (caar apt-utils-package-history) + (length apt-utils-package-history)) + apt-utils-buffer-positions) + ;; Get position for previous package + (setq posns + (gethash (format "%s/%s/%d" + (car (cadr apt-utils-package-history)) + (cdr (cadr apt-utils-package-history)) + (1- (length apt-utils-package-history))) + apt-utils-buffer-positions))) + ((eq type 'toggle) + ;; new/old package types + (let ((package (caar apt-utils-package-history)) + (type (cdar apt-utils-package-history)) + new old) + (if (equal type 'normal) + (setq old 'normal + new 'normal-showpkg) + (setq old 'normal-showpkg + new 'normal)) + ;; Set position for old entry + (apt-utils-puthash (format "%s/%s/%d" + package + old + (length apt-utils-package-history)) + (list (point) (window-start (selected-window))) + apt-utils-buffer-positions) + ;; Get position for new entry + (setq posns + (gethash (format "%s/%s/%d" + package + new + (length apt-utils-package-history)) + apt-utils-buffer-positions + (list 1 1))) ; default value + ))) + posns)) + +(defun apt-utils-current-field-packages () + "Return a list of the packages on the current line." + (let ((keywords '("Conflicts" "Depends" "Enhances" "Package" + "Pre-Depends" "Provides" "Recommends" "Replaces" + "Suggests")) + eol match packages posn string) + (save-excursion + (end-of-line) + (setq eol (point)) + (beginning-of-line) + (cond + ((eobp) + (message "Not on package field line.") + nil) + ((and (re-search-forward "^\\([^ \n:]+\\): " eol t) + (setq match (match-string 1)) + (member match keywords)) + (setq posn (point)) + (goto-char (apt-field-end-position)) + (setq string (buffer-substring-no-properties posn (point))) + (with-temp-buffer + (insert string) + (goto-char (point-min)) + (while (re-search-forward "\n *" nil t) + (replace-match " ")) + (setq packages + ;; Packages split by commas, or alternatives by vertical + ;; bars; for Enhances, multiple lines my be spanned + (split-string (buffer-substring (point-min) (point-max)) + " ?[,|] ?"))) + packages) + (t + (message "Not on package field line.") + nil))))) + +(defun apt-field-end-position () + "Move to end of current field." + (save-excursion + (re-search-forward "\\(^[^: ]+:\\|^$\\)") + (beginning-of-line) + (backward-char) + (point))) + +;; Borrowed from gnus/lisp/time-date.el + +(defun apt-utils-time-less-p (t1 t2) + "Say whether time value T1 is less than time value T2." + (or (< (car t1) (car t2)) + (and (= (car t1) (car t2)) + (< (nth 1 t1) (nth 1 t2))))) + +(defun apt-utils-web-browse-debian-changelog () + "Browse web version of Debian ChangeLog file for the current package." + (interactive) + (apt-utils-web-browse-url + apt-utils-web-browse-debian-changelog-url)) + +(defun apt-utils-web-browse-bug-reports () + "Browse Debian bug reports for the current package." + (interactive) + (apt-utils-web-browse-url + apt-utils-web-browse-bug-reports-url)) + +(defun apt-utils-web-browse-copyright () + "Browse web version of Debian copyright file for the current package." + (interactive) + (apt-utils-web-browse-url + apt-utils-web-browse-copyright-url)) + +(defun apt-utils-web-browse-versions () + "Browse web version information for the current package." + (interactive) + (apt-utils-web-browse-url + apt-utils-web-browse-versions-url)) + +(defun apt-utils-web-browse-url (url) + "Browse Debian-related URL. +The URL can contain tokens that need formatting (see +`apt-utils-web-format-url')." + (cond + ((not (equal major-mode 'apt-utils-mode)) + (message "Not in APT utils buffer.")) + ((not (memq (cdar apt-utils-package-history) '(normal normal-showpkg normal-installed))) + (message "Not a normal package.")) + (t + (browse-url (apt-utils-web-format-url url))))) + +(defun apt-utils-web-format-url (url) + "Format and return Debian URL. +The tokens that can be replaced are: + %d: pool directory + %s: source package name + %p: package name + %v: package version." + (let ((buffer (current-buffer)) + (package (caar apt-utils-package-history)) + (type (cdar apt-utils-package-history)) + char source-package version) + (save-excursion ; for normal package type + (with-temp-buffer + (cond + ((memq type '(normal normal-installed)) + (set-buffer buffer)) + ((eq type 'normal-showpkg) + (call-process apt-utils-apt-cache-program nil '(t nil) nil "show" package))) + (goto-char (point-min)) + (if (re-search-forward "^Source: \\(.*\\)$" (point-max) t) + (setq source-package (match-string 1)) + (setq source-package package)) + (goto-char (point-min)) + (re-search-forward "^Version: \\([0-9]:\\)?\\(.*\\)$" (point-max)) + (setq version (match-string 2)))) + ;; Format the URL + (while (string-match "%\\(.\\)" url) + (setq char (string-to-char (match-string 1 url))) + (setq url (apt-utils-replace-regexp-in-string + (match-string 0 url) + (cond + ((eq char ?d) + (substring source-package 0 + (if (string-match "^lib[a-z]" + source-package) + 4 1))) + ((eq char ?s) source-package) + ((eq char ?p) package) + ((eq char ?v) version) + (t + (error "Unrecognized token (%%%c) in URL: %s" char url))) + url)))) + url) + +(defun apt-utils-packages-needs-update () + "Return t if `apt-utils' package lists needs updating." + (or (not apt-utils-package-list-built) + (apt-utils-time-less-p apt-utils-package-list-built + (nth 5 (file-attributes apt-utils-timestamped-file))))) + +(defun apt-utils-update-mode-name () + "Update `mode-name' for all buffers in `apt-utils-mode'." + (let* ((need-update (apt-utils-packages-needs-update)) + (update-string + (and need-update + (substitute-command-keys + ": update using \\\\[apt-utils-rebuild-package-lists]"))) + (name (concat "APT utils" update-string))) + (mapc (lambda (b) + (with-current-buffer b + (when (eq major-mode 'apt-utils-mode) + (setq mode-name name)))) + (buffer-list)))) + +(defun apt-utils-current-links-add-package (package) + "Add PACKAGE to `apt-utils-current-links' hashtable." + (unless (eq package 'broken) + (apt-utils-puthash package nil apt-utils-current-links))) + +;; Mode settings + +(defvar apt-utils-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "#") 'apt-utils-rebuild-package-lists) + (define-key map (kbd "1") 'delete-other-windows) + (define-key map (kbd "<") 'apt-utils-view-previous-package) + (define-key map (kbd ">") 'apt-utils-choose-package-link) + (define-key map (kbd "?") 'describe-mode) + (define-key map (kbd "DEL") 'scroll-down) + (define-key map (kbd "M-TAB") 'apt-utils-previous-package) + (define-key map (kbd "RET") 'apt-utils-follow-link) + (define-key map (kbd "S s") 'apt-utils-search) + (define-key map (kbd "S f") 'apt-utils-search-file-names) + (define-key map (kbd "S g") 'apt-utils-search-grep-dctrl) + (define-key map (kbd "S n") 'apt-utils-search-names-only) + (define-key map (kbd "SPC") 'scroll-up) + (define-key map (kbd "TAB") 'apt-utils-next-package) + (define-key map (kbd "b C") 'apt-utils-web-browse-debian-changelog) + (define-key map (kbd "b b") 'apt-utils-web-browse-bug-reports) + (define-key map (kbd "b l") 'apt-utils-web-browse-copyright) + (define-key map (kbd "b v") 'apt-utils-web-browse-versions) + (define-key map (kbd "d") 'apt-utils-describe-package) + (when (fboundp 'window-list) + (define-key map (kbd "k") 'apt-utils-kill-other-window-buffers)) + (define-key map (kbd "l") 'apt-utils-list-package-files) + (define-key map (kbd "o") 'other-window) + (define-key map (kbd "q") 'apt-utils-quit) + (define-key map (kbd "s") 'apt-utils-show-package) + (define-key map (kbd "t") 'apt-utils-toggle-package-info) + (define-key map (kbd "v C") 'apt-utils-view-debian-changelog) + (define-key map (kbd "v R") 'apt-utils-view-debian-readme) + (define-key map (kbd "v N") 'apt-utils-view-debian-news) + (define-key map (kbd "v c") 'apt-utils-view-changelog) + (define-key map (kbd "v e") 'apt-utils-view-emacs-startup-file) + (define-key map (kbd "v f") 'apt-utils-view-package-files) + (define-key map (kbd "v l") 'apt-utils-view-copyright) + (define-key map (kbd "v m") 'apt-utils-view-man-page) + (define-key map (kbd "v n") 'apt-utils-view-news) + (define-key map (kbd "v r") 'apt-utils-view-readme) + (define-key map (kbd "v v") 'apt-utils-view-version) + (define-key map [(shift iso-lefttab)] 'apt-utils-previous-package) + (define-key map [(shift tab)] 'apt-utils-previous-package) + (define-key map + (if apt-utils-xemacs-p '(button2) (kbd "")) + 'apt-utils-mouse-follow-link) + map) + "Keymap for apt-utils mode.") + +;; Menus + +(defvar apt-utils-menu nil + "Menu to use for `apt-utils-mode'.") + +(when (fboundp 'easy-menu-define) + + (easy-menu-define apt-utils-menu apt-utils-mode-map "Apt Utils Menu" + `("Apt Utils" + ["Show Package" apt-utils-show-package t] + ["Toggle Package Info" apt-utils-toggle-package-info + (apt-utils-toggle-package-p)] + ["View Previous Package" apt-utils-view-previous-package + (apt-utils-previous-package-p)] + ["Choose Package Link" apt-utils-choose-package-link + (> (hash-table-count apt-utils-current-links) 0)] + ["Next Package Link" apt-utils-next-package + (> (hash-table-count apt-utils-current-links) 0)] + ["Previous Package Link" apt-utils-previous-package + (> (hash-table-count apt-utils-current-links) 0)] + ["Follow Link at Point" apt-utils-follow-link + (apt-utils-package-at-point)] + ["Rebuild Package Lists" apt-utils-rebuild-package-lists t] + "---" + ("Search" + ["Package Descriptions" apt-utils-search t] + ["Package Names" apt-utils-search-names-only t] + ["Installed Files" apt-utils-search-file-names t] + ["Grep-Dctrl" apt-utils-search-grep-dctrl t]) + ("View Files" + ,@(list (if apt-utils-xemacs-p + :included + :active) + '(apt-utils-current-package-installed-p)) + ["ChangeLog" apt-utils-view-changelog + (apt-utils-changelog-file)] + ["Debian ChangeLog" apt-utils-view-debian-changelog + (apt-utils-debian-changelog-file)] + ["README" apt-utils-view-readme + (apt-utils-readme-file)] + ["Debian README" apt-utils-view-debian-readme + (apt-utils-debian-readme-file)] + ["NEWS" apt-utils-view-news + (apt-utils-news-file)] + ["Debian NEWS" apt-utils-view-debian-news + (apt-utils-debian-news-file)] + ["Copyright" apt-utils-view-copyright + (apt-utils-copyright-file)] + "---" + ["Man Page" apt-utils-view-man-page + (apt-utils-current-package-installed-p)] + "---" + ["All Package Files (dired)" apt-utils-view-package-files + (apt-utils-current-package-installed-p)]) + ("Browse URL" + ,@(list (if apt-utils-xemacs-p + :included + :active) + '(apt-utils-toggle-package-p)) + ["Debian ChangeLog" apt-utils-web-browse-debian-changelog t] + ["Bug Reports" apt-utils-web-browse-bug-reports t] + ["Copyright" apt-utils-web-browse-copyright t] + ["Package Versions" apt-utils-web-browse-versions t]) + "---" + ["Help" describe-mode t] + ["Quit" apt-utils-quit t]))) + +(defun apt-utils-mode () + "Major mode to interface Emacs with APT (Debian package management). + +Start things off with, for example: + + M-x apt-utils-show-package RET emacs21 RET + +Other packages (dependencies, conflicts etc.) can be navigated +using: + + \\[apt-utils-toggle-package-info] toggle package and showpkg information + \\[apt-utils-view-previous-package] show the previous package from history + \\[apt-utils-choose-package-link] choose next package from current links + \\[apt-utils-next-package] move to next package link + \\[apt-utils-previous-package] move to previous package link + \\[apt-utils-follow-link] show package for the link at point + \\[apt-utils-list-package-files] list package files (in a `dired' buffer) + +Confirmation will be requested before updating the list of known +packages. The update can be started at any time with +\\[apt-utils-rebuild-package-lists]. + +Package searches can be performed using: + + \\[apt-utils-search] search for regular expression in package names and descriptions + \\[apt-utils-search-names-only] search for regular expression in package names + \\[apt-utils-search-file-names] search for string in filenames + \\[apt-utils-search-grep-dctrl] search for regular expression in selected package fields + (using the grep-dctrl program) + +Files associated with installed packages can be accessed using: + + \\[apt-utils-view-changelog] view ChangeLog file + \\[apt-utils-view-debian-changelog] view Debian ChangeLog file + \\[apt-utils-view-readme] view README file + \\[apt-utils-view-debian-readme] view Debian README file + \\[apt-utils-view-news] view NEWS file + \\[apt-utils-view-debian-news] view Debian NEWS file + \\[apt-utils-view-copyright] view copyright (licence) file + \\[apt-utils-view-man-page] view man page + +Web locations can be visited using: + + \\[apt-utils-web-browse-debian-changelog] browse Debian ChangeLog URL + \\[apt-utils-web-browse-bug-reports] browse bug report URL + \\[apt-utils-web-browse-copyright] browse copyright (licence) URL + \\[apt-utils-web-browse-versions] browse package versions URL + +A history of navigated packages is maintained when package links +are followed using `apt-utils-choose-package-link' or +`apt-utils-follow-link'. This history is reset when +`apt-utils-show-package' or any of the search commands is used. + +Key definitions: +\\{apt-utils-mode-map}" + (kill-all-local-variables) + (use-local-map apt-utils-mode-map) + (setq major-mode 'apt-utils-mode) + (setq mode-name "APT utils") + (setq buffer-undo-list t) + (setq truncate-lines t) + ;; XEmacs + (when (and (fboundp 'easy-menu-add) + apt-utils-menu) + (easy-menu-add apt-utils-menu)) + (add-hook 'kill-buffer-hook 'apt-utils-cleanup nil t) + (run-hooks 'apt-utils-mode-hook)) + +;; Debugging + +(defun apt-utils-trace-all () + "Trace all `apt-utils' functions. For debugging." + (require 'trace) + (let ((buffer (get-buffer-create "*APT Utils Trace*"))) + (buffer-disable-undo buffer) + (all-completions "apt-utils" obarray + (lambda (sym) + (and (fboundp sym) + (not (memq (car-safe (symbol-function sym)) + '(autoload macro))) + (trace-function-background sym buffer)))))) + +(defun apt-utils-sort-result () + (save-excursion + (goto-char (point-min)) + (forward-line 2) + (sort-lines nil (point) (point-max)))) + +(provide 'apt-utils) + +;;; apt-utils.el ends here diff --git a/elisp/debian-el/deb-view.el b/elisp/debian-el/deb-view.el new file mode 100755 index 0000000..072fc88 --- /dev/null +++ b/elisp/debian-el/deb-view.el @@ -0,0 +1,715 @@ +;;; deb-view.el --- view Debian package files with tar-mode + +;; Copyright (C) 1998 Rick Macdonald +;; Copyright (C) 2003, 2004, 2005, 2009 Peter S Galbraith + +;; Author: Rick Macdonald +;; Maintainer: Peter S. Galbraith +;; Version: 1.15 + +;; This file is not part of GNU Emacs. + +;; deb-view 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. + +;; deb-view 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 deb-view; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; deb-view presents the contents of debian package archive files for +;; viewing. The viewing is done with the major mode "debview", which +;; is derived from emacs tar-mode with a few enhancements for viewing +;; compressed files, HTML files and formatted man pages. The normal +;; editing and saving features of tar-mode are not supported by +;; deb-view. + +;; deb-view includes a command called deb-find which requires that you +;; have the debian distribution directories on a local or mounted +;; filesystem. Give it a string or regular expression and it presents a +;; buffer of matching deb file names. Click with the middle mouse button +;; or press RETURN (or ^C^C) and it launches deb-view on the selected +;; file. deb-find can be configured to use locate or find, or any other +;; external command. The find method passes your search specification to +;; egrep, whereas the locate method uses your string directly. + +;; deb-view extracts the control.tar.gz and data.tar.gz files from +;; debian package and presents two buffers in a derivitive of +;; tar-mode. See tar-mode for info. + +;; Required programs: ar, gzip. +;; Optionally required programs: nroff for formatting man pages. +;; Optionally required programs: dpkg-deb for old-style binary .deb files. +;; Optionally required programs: w3-mode for viewing HTML pages. + +;; For new-style .deb files (2.0), dpkg-deb isn't used. Therefore +;; deb-view should work on any platform with the ar command, although +;; "ar -p" doesn't seem to work for .deb files on Solaris 2.4 and 2.5. +;; It works on Solaris 2.6, SGI's IRIX 6.1 and 6.2, and Linux, of course. + +;; Old-style .deb files require the dpkg-deb program. I don't know how to +;; extract control.tar.gz from these deb files, so you only get to see +;; the package control file, but nothing else such as the install scripts. +;; If you know how to get the control.tar.gz file out, let me know! +;; The data file is still viewable thanks to the "dpkg-deb --fsys-tarfile" +;; option. + +;;; Installation: + +;; 1) Quick test to see if you like deb-view. + +;; Put this file in your home directory, and call it deb-view.el. +;; Start up emacs and do the following: +;; ESCAPE x load-file RETURN ~/deb-view.el RETURN +;; Then, view a deb file with CTRL-d in Dired mode, +;; or execute: +;; ESCAPE x deb-view RETURN {/full/path/of/file.deb} RETURN +;; or execute: +;; ESCAPE : (setq deb-find-directory "/your/debian/directory") RETURN +;; ESCAPE x deb-find RETURN {deb-file-search-string} RETURN +;; and select a deb file to view with RETURN or middle mouse button in +;; the search results buffer that is created. Exit this buffer with "q". + +;; 2) Permanent installation. + +;; When installed this way, all find-file operations (such as "f" or "v" in +;; dired-mode) will automatically recognize debian files and load deb-view +;; when required. + +;; Put this file somewhere where Emacs can find it (i.e., in one of the paths +;; in your `load-path'), `byte-compile-file' it, and put the following six +;; lines (with semi-colons removed) in your ~/.emacs file (or create ~/.emacs +;; if you don't have one): +;;(autoload 'deb-find "deb-view" "Debian Archive File Finder" t) +;;(autoload 'deb-view-mode "deb-view" "Debian Archive File Mode" t) +;;(autoload 'deb-view "deb-view" "Debian Archive File Viewer" t) +;;(autoload 'deb-view-dired-view "deb-view" "Debian Archive File Viewer" t) +;;(setq auto-mode-alist (append '(("\\.deb$" . deb-view-mode)) auto-mode-alist)) +;;(define-key dired-mode-map "\C-d" 'deb-view-dired-view) + +;; If you're not very familiar with emacs customization, here is a simpler +;; approach. Add this line to your ~/.emacs file (or create ~/.emacs if you +;; don't have one): +;; (load "~/deb-view.el") +;; Or, if you can put deb-view into your load-path (execute +;; "^h v load-path RETURN" to see your load-path setting) +;; then just add the following to your ~./emacs file: +;; (require 'deb-view) + +;; deb-view is mostly unobtrusive, but does bind ^d in dired to +;; deb-view-dired-view. The "debview" mode is derived from +;; tar-mode.el using derived.el. Compared to tar-mode, debview-mode +;; binds q, N, W, and re-binds v. Also, the normal editing and saving +;; features of tar-mode are not supported by debview mode and those +;; keys are disabled. + +;; 3) Configuration + +;; deb-find has two variables to set. deb-find-method can be "locate" or +;; "find". Any other value will be assumed to be an external script or +;; program that you supply. If you set deb-find-method to "find" then you +;; must also set deb-find-directory to the directory containing the +;; debian distribution. The find command starts at this point. I originally +;; used the locate option, but contrary to the man page it doesn't seem to +;; understand even simple regular expressions. I prefer the find option. It +;; uses egrep and therefore understands complex regular expressions. +;; You might want to bind deb-find to a special key. I use ^C^D like this: +;; (define-key ctl-x-map "\C-d" 'deb-find) +;; Note that this key is normally the brief list-directory command, a +;; command that I never used anyway. + + +;;; Usage: + +;; In dired, press f or e on the dired line of the .deb file to view. +;; You can also use ^d, which is actually slightly faster since the +;; deb file isn't loaded into a buffer needlessly. + +;; Or, execute: ESCAPE x deb-view RETURN, and enter the .deb file name +;; at the prompt. + +;; Or, execute: ESCAPE x deb-find RETURN, and enter any substring of a +;; deb file name to search for. A buffer of matches is created. +;; Launch deb-view by selecting a deb file with the middle mouse button, +;; or RETURN or ^c^c. Exit this buffer with "q". + +;; You are shown two tar files in debview-mode (see tar-mode for help). +;; In the case of old .deb format files, the control info is shown +;; but not the other files of control.tar, such as install scripts. +;; Note that regular tar-mode commands e, f and RETURN show raw files +;; without any special uncompressing or formatting. +;; Additional features that deb-view adds to tar-mode: +;; q - kill both view buffers (INFO and DATA) and return to the +;; dired buffer if that's where you executed deb-mode. +;; v - executes deb-view-tar-view instead of tar-view, with the +;; additional smarts to uncompress .gz and .Z files for viewing. +;; N - Like in dired, formats man pages for viewing, with the +;; additional smarts to uncompress .gz and .Z man files for viewing. +;; W - use w3-mode to view an HTML file. + +;; To view files not supported by deb-view, such as graphics, use the +;; copy command ("c") to copy the file to a temp directory. You can +;; then do what you want to the file. + + +;;; History: +;; + +;; 1.3 - modified logic that determines old or new style Debian packages. +;; On systems where the file command recognizes debian files, it +;; wrongly always came up with old format. + +;; 1.4 - added missing semicolons in the comments for Changelog 1.3. +;; - fixed various spacing issues in doc strings. +;; - disabled tar-mode keys that are not applicable to deb-view. + +;; 1.5 - added an auto-mode-alist and deb-view mode so that deb-view +;; is launched from any find-file command. +;; - added a deb-find command that takes a search string and creates +;; a buffer of matching deb files. ^C^C, RETURN or middle mouse button +;; runs deb-view on the selected deb file. +;; - added deb-view-help to "?" key in deb-view. + +;; 1.6 - improved doc strings for deb-find and deb-find-method. +;; - added (provide 'deb-view) and instructions for using +;; (require 'deb-view). +;; - reworked the documentation somewhat, but it's still too long. +;; - changed the copyright notice to refer to deb-view, not Emacs. + +;; 1.7 - make copy of compilation-minor-mode map rather than changing +;; it directly. It was breaking actual compilation buffer keymaps, +;; such as grep mode. + +;; 1.8 - fixed deb-find when deb-find-method is set to "find". It wasn't +;; adding "/*" to the end of the directory name for the find command. + +;; 1.9 - Added support for handling remote deb files (ange-ftp). +;; - reworked to use derived.el instead of messing with tar-mode +;; directly. (Thanks to era eriksson ) + +;; 1.10 2003-10-30 +;; - New maintainer: Peter S. Galbraith +;; - checkdoc edits. +;; - made defvars into defcustoms. + +;; 1.11 2004-01-16 Peter S. Galbraith +;; - Resize top (control) window to fit number of lines since it +;; doesn't really need to be 1/2 the screen. Thanks to Dan +;; Jacobson for suggesting this change (Closes: #224950). + +;; 1.12 2005-10-24 Peter S. Galbraith +;; - Output an error message if the package file is corrupted +;; (e.g. partial download). +;; Thanks to Dan Jacobson for suggesting this change (Closes: #235673). +;; - deb-view-dired-view: Check if file in dired is a .deb before opening. +;; Thanks to Dan Jacobson for suggesting this change (Closes: #273902) +;; - deb-view-tar-view: If the file to be opned is from the INFO buffer, +;; then open in the other (larger) window. +;; Thanks to Dan Jacobson for suggesting this change (Closes: #321869) + +;; 1.13 2006-02-02 Sven Joachim +;; Bug fix for UTF-8 (Closes: #344260) +;; The `call-process' and `call-process-region' use +;; default-process-coding-system rather than coding-system-for-read. +;; The former is set to '(mule-utf-8 . mule-utf-8) in my setup, and that +;; caused the problem. So the solution is to bind +;; default-process-coding-system as well in deb-view-process + +;; 1.14 2009-10-25 Peter S. Galbraith +;; Added support for data.tar.bz2 deb files (Closes: #457094). + +;; 1.15 2009-11-02 Peter S. Galbraith +;; Fixed stupid bug "deb-view.el fails on own debian-el_30.9-1_all.deb", +;; thanks to Kevin Ryde (Closes: #554039). + +;; 1.16 2011-08-16 Peter S. Galbraith +;; Added support for data.tar.xz deb files (Closes: #637579). + +;;; Code: + +(defgroup deb-view nil + "View Debian package files with tar-mode" + :group 'tools + :prefix "deb-view") + +(defcustom deb-view-tar-uncompress-program "gzip -cd" + "*Program to use for uncompression of .gz and .Z files in `deb-view'." + :group 'deb-view + :type 'string) + +;; Note the following useful variable from tar-mode: +;;(defvar tar-mode-show-date nil +;; "*Non-nil means Tar mode should show the date/time of each subfile. +;;This information is useful, but it takes screen space away from file names.") + +(defcustom deb-find-method "find" + "Internal `deb-find' methods supported: locate or find. +Any other entry is assumed to be an external command. +See also the variable deb-find-directory." + :group 'deb-view + :type '(radio (const "find") (const "locate"))) + +(defcustom deb-find-directory "/usr/local/src/debian" + "Directory to run find in when deb-find-method is \"find\"." + :group 'deb-view + :type 'directory) + +(define-derived-mode debview-mode tar-mode "debview" + "Major mode for debview.\n\n\\{debview-mode-map}") + +;; Prohibit things that tar-mode does that deb-view doesn't: +(define-key debview-mode-map "\C-d" 'undefined) +(define-key debview-mode-map "G" 'undefined) +(define-key debview-mode-map "M" 'undefined) +(define-key debview-mode-map "O" 'undefined) +(define-key debview-mode-map "d" 'undefined) +(define-key debview-mode-map "g" 'undefined) +(define-key debview-mode-map "r" 'undefined) +(define-key debview-mode-map "u" 'undefined) +(define-key debview-mode-map "x" 'undefined) +(define-key debview-mode-map "" 'undefined) + +(define-key debview-mode-map "?" 'deb-view-help) +(define-key debview-mode-map "q" 'deb-view-dired-view-cleanup) +(define-key debview-mode-map "N" 'deb-view-tar-man) +(define-key debview-mode-map "W" 'deb-view-tar-w3) +(define-key debview-mode-map "v" 'deb-view-tar-view) +(define-key debview-mode-map [up] 'tar-previous-line) +(define-key debview-mode-map [down] 'tar-next-line) +(define-key debview-mode-map "\eOA" 'tar-previous-line) +(define-key debview-mode-map "\eOB" 'tar-next-line) +(define-key debview-mode-map "\e[A" 'tar-previous-line) +(define-key debview-mode-map "\e[B" 'tar-next-line) + +(defvar deb-view-dired-view-return-buffer "" + "Return to this buffer after deb-view-dired-view-cleanup is called.") +(make-variable-buffer-local 'deb-view-dired-view-return-buffer) + +(defvar deb-view-tempfile "" + "Flag saying if the deb file is temporary (ange-ftp) and needs deleting.") + +(defvar deb-view-file-name "" + "The file name being processed by `deb-view'.") + +;; You might not like the key bindings that I chose: +(if (featurep 'dired) + (define-key dired-mode-map "\C-d" 'deb-view-dired-view) + (add-hook + 'dired-load-hook + (function (lambda () + (define-key dired-mode-map "\C-d" 'deb-view-dired-view))))) + +;;;###autoload +(defun deb-view-dired-view () + "View Debian package control and data files. +Press \"q\" in either window to kill both buffers +and return to the dired buffer. See deb-view." + (interactive) + (let ((file (dired-get-filename))) + (if (string-match ".deb$" file) + (deb-view file) + (error "Not a Debian package file")))) + +;;;###autoload +(defun deb-view (debfile) + "View Debian package DEBFILE's control and data files. +Press \"q\" in either window to kill both buffers. + +In dired, press ^d on the dired line of the .deb file to view. +Or, execute: ESCAPE x deb-view RETURN, and enter the .deb file name +at the prompt." + (interactive "fdeb file to view: ") + (if (and (or (string-match "Lucid" emacs-version) + (string-match "XEmacs" emacs-version)) + (>= emacs-major-version 21)) + (require 'view-less) + (require 'view)) + (require 'view) + (if (< (nth 1 (file-attributes debfile)) 0) + (progn + ;; This is a remote file. + ;; Call view-file to force ange-ftp to get it first. + (message "deb-view remote file: %s" debfile) + (find-file debfile)) + ;; This is a local file. + (setq debfile (expand-file-name debfile)) + ;;(message "deb-view local file: %s" debfile) + (setq deb-view-file-name debfile) + (setq deb-view-tempfile nil) + (deb-view-process debfile))) + +(defun deb-view-process (debfile) + "View Debian Archive Files for package DEBFILE." + (let* ((deb-view-buffer-name (file-name-nondirectory deb-view-file-name)) + (info-buffer-name (concat deb-view-buffer-name "-INFO")) + (data-buffer-name (concat deb-view-buffer-name "-DATA")) + (info-buffer (progn (and (get-buffer info-buffer-name) + (kill-buffer (get-buffer info-buffer-name))) + (get-buffer-create info-buffer-name))) + (data-buffer (progn (and (get-buffer data-buffer-name) + (kill-buffer (get-buffer data-buffer-name))) + (get-buffer-create data-buffer-name))) + (return-buffer (current-buffer)) + (coding-system-for-read 'no-conversion) + (default-process-coding-system '(no-conversion . no-conversion)) + file-buffer + new-archive-format) + (message "deb-view processing deb file %s..." deb-view-buffer-name) + ;; info + (setq file-buffer (get-buffer-create " *file-data*")) + (setq new-archive-format + (save-excursion + (set-buffer file-buffer) + (erase-buffer) + (call-process shell-file-name nil t nil shell-command-switch + (concat "file " debfile)) + (goto-char 1) + (if (string-match "archive" (buffer-string)) + t + (goto-char 1) + (if (string-match "old debian" (buffer-string)) + nil + t)))) + (kill-buffer file-buffer) + (set-buffer info-buffer) + (cond + (new-archive-format + ;; New deb format (archive) + (call-process shell-file-name nil t nil shell-command-switch + (concat "ar -p " debfile + " control.tar.gz | gzip -cd")) + (goto-char 1) + (setq buffer-file-name (concat deb-view-file-name "-INFO")) + (if (fboundp 'set-buffer-multibyte) (set-buffer-multibyte nil)) + (debview-mode) + ;; Turn off view-mode in this buffer: + (make-variable-buffer-local 'view-mode-hook) + (add-hook + 'view-mode-hook + (function (lambda () + (view-mode -1) + (setq view-exit-action 'deb-view-dired-view-cleanup)))) + (message "deb-view processing deb file %s..." deb-view-buffer-name) + (tar-next-line 1) + (switch-to-buffer info-buffer t)) + (t + ;; Old deb format + (message "deb-view old dpkg binary format") + (call-process shell-file-name nil t nil shell-command-switch + (concat "dpkg-deb -I " debfile)) + (setq buffer-read-only t) + (set-buffer-modified-p nil) + (goto-char 1) + (switch-to-buffer info-buffer t) + (view-mode-enter return-buffer 'deb-view-dired-view-cleanup))) + (set-buffer-modified-p nil) + (setq buffer-read-only t) + (setq deb-view-dired-view-return-buffer return-buffer) + (delete-other-windows) + ;; data + (set-buffer data-buffer) + (buffer-disable-undo) + (cond + (new-archive-format + (call-process "ar" nil '(t t) nil "-t" debfile) + (goto-char 1) + (cond + ((re-search-forward "data.tar.gz" nil t) + (erase-buffer) + (call-process "ar" nil '(t t) nil "-p" debfile "data.tar.gz") + (goto-char (point-max)) + (when (search-backward "is not a valid archive" nil t) + (kill-buffer data-buffer) + (kill-buffer info-buffer) + (error "%s: Not a valid package file" deb-view-buffer-name)) + (call-process-region (point-min) (point-max) "gzip" t t nil "-cd")) + ((and (goto-char 1)(re-search-forward "data.tar.bz2" nil t)) + (erase-buffer) + (call-process "ar" nil '(t t) nil "-p" debfile "data.tar.bz2") + (goto-char (point-max)) + (when (search-backward "is not a valid archive" nil t) + (kill-buffer data-buffer) + (kill-buffer info-buffer) + (error "%s: Not a valid package file" deb-view-buffer-name)) + (call-process-region (point-min) (point-max) "bzip2" t t nil "-cd")) + ((and (goto-char 1)(re-search-forward "data.tar.xz" nil t)) + (erase-buffer) + (call-process "ar" nil '(t t) nil "-p" debfile "data.tar.xz") + (goto-char (point-max)) + (when (search-backward "is not a valid archive" nil t) + (kill-buffer data-buffer) + (kill-buffer info-buffer) + (error "%s: Not a valid package file" deb-view-buffer-name)) + (call-process-region (point-min) (point-max) "xz" t t nil "-cd")))) + (t + (call-process shell-file-name nil t nil shell-command-switch + (concat "dpkg-deb --fsys-tarfile " debfile)))) + (goto-char 1) + (setq buffer-file-name (concat deb-view-file-name "-DATA")) + (if (fboundp 'set-buffer-multibyte) (set-buffer-multibyte nil)) + (debview-mode) + (message "deb-view processing deb file %s..." deb-view-buffer-name) + (tar-next-line 1) + (setq deb-view-dired-view-return-buffer return-buffer) + (set-buffer-modified-p nil) + (setq buffer-read-only t) + (buffer-enable-undo) + (switch-to-buffer-other-window data-buffer) + (if new-archive-format (other-window 1)) + (shrink-window-if-larger-than-buffer) + (when deb-view-tempfile + (message "deb-view deleting tempfile: %s" debfile) + (delete-file debfile)) + (message "deb-view: ? for help. q to quit."))) + +;;;###autoload +(defun deb-view-mode () + "View mode for Debian Archive Files." + (interactive) + (let ((debfile buffer-file-name) + (return-buffer (nth 0 (buffer-list))) + (curbuf (current-buffer))) + (setq deb-view-file-name debfile) + (if (< (nth 1 (file-attributes debfile)) 0) + (progn + (message "deb-view remote file: %s" debfile) + (setq debfile (make-temp-name "/tmp/deb-view.")) + ;;(message "deb-view processing deb file %s..." debfile) + (write-file debfile) + (setq deb-view-tempfile t)) + ;;(message "deb-view local file: %s" debfile) + (setq deb-view-tempfile nil)) + (set-buffer return-buffer) + (kill-buffer curbuf) + (deb-view-process debfile))) + +;;;###autoload +(defun deb-find () + "Search for deb files. +Use the method specified by the variable deb-find-method, and collect +output in a buffer. See also the variable deb-find-directory. + +This command uses a special history list, so you can +easily repeat a `deb-find' command." + (interactive) + (require 'compile) + (let* ((deb-file-string (read-from-minibuffer "deb file to find: " + nil nil nil 'deb-find-history)) + (output-buffer-name "*deb-find*") + (command (cond ((string-equal deb-find-method "locate") + (concat "locate '" deb-file-string + "' | egrep '\.deb$'")) + ((string-equal deb-find-method "find") + (concat "find " deb-find-directory "/* | egrep '" + deb-file-string "' | egrep '\.deb$'")) + (t + (concat deb-find-method " '" deb-file-string "'"))))) + (compile-internal command "Not applicable in deb-find" "deb-find" nil nil + (function (lambda (mode) output-buffer-name))) + (switch-to-buffer-other-window output-buffer-name) + (setq deb-view-find-minor-mode-map + (copy-keymap compilation-minor-mode-map)) + (use-local-map deb-view-find-minor-mode-map) + (define-key deb-view-find-minor-mode-map [mouse-2] + 'deb-find-mouse-deb-view) + (define-key deb-view-find-minor-mode-map "\C-c\C-c" 'deb-find-deb-view) + (define-key deb-view-find-minor-mode-map "\C-m" 'deb-find-deb-view) + (define-key deb-view-find-minor-mode-map "?" 'deb-find-help) + (define-key deb-view-find-minor-mode-map "q" 'kill-this-buffer) + (define-key deb-view-find-minor-mode-map "\M-n" 'undefined) + (define-key deb-view-find-minor-mode-map "\M-p" 'undefined) + (define-key deb-view-find-minor-mode-map "\M-{" 'undefined) + (define-key deb-view-find-minor-mode-map "\M-}" 'undefined) + (beginning-of-buffer) + (message "deb-view: ? for help. q to quit."))) + + +;;; Internal functions: + +(defvar deb-view-version "1.9" + "The version of `deb-view'.") + +(defun deb-view-version () + "Return string describing the version of `deb-view'. +When called interactively, displays the version." + (interactive) + (if (interactive-p) + (message "deb-view version %s" (deb-view-version)) + deb-view-version)) + +(defun deb-view-dired-view-cleanup (&optional buffer) + "Delete the buffers created by deb-view-dired-view." + (interactive) + (let* ((quit-buffer (or buffer (current-buffer))) + (bufname (buffer-name quit-buffer)) + (debfile (substring bufname 0 (- (length bufname) 5))) + (info-buffer (get-buffer (concat debfile "-INFO"))) + (data-buffer (get-buffer (concat debfile "-DATA"))) + (ddir-buffer (save-excursion + (set-buffer quit-buffer) + deb-view-dired-view-return-buffer))) + (delete-other-windows) + (and (buffer-live-p info-buffer) + (kill-buffer info-buffer)) + (and (buffer-live-p data-buffer) + (kill-buffer data-buffer)) + (and (buffer-live-p quit-buffer) + (kill-buffer quit-buffer)) + (and (buffer-live-p ddir-buffer) + (switch-to-buffer ddir-buffer)))) + +(defun deb-find-help () + "Show help information for `deb-find'." + (interactive) + (with-output-to-temp-buffer "*Help*" + (princ (format "deb-find mode: version %s" (deb-view-version))) + (princ "\n +RET - view the deb file on this line with deb-view. +C-c C-c - view the deb file on this line with deb-view. +mouse-2 - view the deb file on this line with deb-view. +? - show deb-find-help. +q - quit deb-find.") + (save-excursion + (set-buffer standard-output) + (help-mode)) + (print-help-return-message))) + +(defun deb-view-help () + "Show help information for `deb-view'." + (interactive) + (with-output-to-temp-buffer "*Help*" + (princ (format "deb-view mode: version %s" (deb-view-version))) + (princ " +Derived from tar-mode, with additional features for viewing deb files. +Execute \"^h m\" to see tar-mode bindings. + +You are shown two tar files in tar-mode (see tar-mode for help). +In the case of old .deb format files, the control info is shown +but not the other files of control.tar, such as install scripts. + +Note that regular tar-mode commands e, f and RETURN show raw files +without any special uncompressing or formatting. + +Additional features that deb-view adds to tar-mode: +? - show deb-view help. +q - kill both view buffers (INFO and DATA) and return to the + dired buffer if that's where you executed deb-mode. +v - executes deb-view-tar-view instead of tar-view, with the + additional smarts to uncompress .gz and .Z files for viewing. +N - Like in dired, formats man pages for viewing, with the + additional smarts to uncompress .gz and .Z man files for viewing. +W - use w3-mode to view an HTML file. +These functions are also available in tar-mode on normal tar files +when deb-view is loaded. + +To view files not supported by deb-view, such as graphics, use the +copy command in tar-mode (\"c\") to copy the file to a temp directory. +You can then do what you want to the file.") + (save-excursion + (set-buffer standard-output) + (help-mode)) + (print-help-return-message))) + +(defun deb-view-tar-man () + "*In Tar mode, view the tar file entry on this line as a man page." + (interactive) + (require 'man) + (let ((auto-mode-alist + (append '(("\\.gz$" . deb-view-tar-uncompress-while-visiting) + ("\\.Z$" . deb-view-tar-uncompress-while-visiting) + ) auto-mode-alist))) + (tar-extract 'view) + (setq buffer-read-only nil) + (shell-command-on-region (point-min) (point-max) "nroff -man -h " t t) + (Man-cleanup-manpage) + (setq buffer-read-only t) + (set-buffer-modified-p nil) + (message ""))) + +(defun deb-view-tar-uncompress-while-visiting () + "Temporary \"major mode\" used for .Z and .gz files, to uncompress them. +It then selects a major mode from the uncompressed file name and contents. +\(Modifed uncompress-while-visiting from uncompress.el\)" + (interactive) + (message "Uncompressing...") + (let ((buffer-read-only nil)) + (shell-command-on-region (point-min) (point-max) + deb-view-tar-uncompress-program t)) + (message "Uncompressing...done") + (set-buffer-modified-p nil) + (goto-char 1)) + +(defun deb-view-tar-view () + "*In Tar mode, view the tar file entry on this line. +If the file is from the INFO buffer, then open in the other (larger) window." + (interactive) + (let ((auto-mode-alist + (append '(("\\.gz$" . deb-view-tar-uncompress-while-visiting) + ("\\.Z$" . deb-view-tar-uncompress-while-visiting) + ) auto-mode-alist))) + (if (string-match "INFO$" buffer-file-name) + (tar-extract-other-window) + (tar-extract 'view)))) + +(defun deb-view-tar-w3 () + "*In Tar mode, view the tar file entry on this line as HTML with w3-mode." + (interactive) + (if (fboundp 'w3-preview-this-buffer) + (let ((auto-mode-alist + (append '(("\\.gz$" . deb-view-tar-uncompress-while-visiting) + ("\\.Z$" . deb-view-tar-uncompress-while-visiting) + ) auto-mode-alist))) + (tar-extract 'view) + (rename-buffer (concat " " (buffer-name))) + (w3-preview-this-buffer) + (define-key w3-mode-map "q" 'deb-view-tar-w3-quit)) + (error "Sorry, you don't seem to have w3 loaded"))) + +(defun deb-view-tar-w3-quit () + "Quit WWW mode in a buffer from `deb-view'." + (interactive) + (let ((x w3-current-last-buffer)) + (and (fboundp 'w3-mpeg-kill-processes) (w3-mpeg-kill-processes)) + (kill-buffer (current-buffer)) + (if (and (bufferp x) (buffer-name x)) + (if w3-mutable-windows (pop-to-buffer x) (switch-to-buffer x)))) + (view-exit)) + +(defvar deb-find-history nil + "History list for `deb-find' commands.") + +(defvar deb-find-regexp "^/.*\.deb$" + "Regexp for deb file names in the `deb-find' buffer.") + +(defun deb-find-deb-view () + "Run `deb-view' in package under point." + (interactive) + (let ((deb-file (thing-at-point 'filename))) + (if (and deb-file + (string-match deb-find-regexp deb-file)) + (deb-view (thing-at-point 'filename)) + (error "No deb file on this line")))) + +(defun deb-find-mouse-deb-view (event) + "Run `deb-view' in package under mouse EVENT." + (interactive "e") + (pop-to-buffer (window-buffer (posn-window (event-end event)))) + (goto-char (posn-point (event-end event))) + (let ((deb-file (thing-at-point 'filename))) + (if (and deb-file + (string-match deb-find-regexp deb-file)) + (deb-view (thing-at-point 'filename)) + (error "No deb file on this line")))) + +(provide 'deb-view) + +;;; deb-view.el ends here diff --git a/elisp/debian-el/debian-bug.el b/elisp/debian-el/debian-bug.el new file mode 100755 index 0000000..b856b65 --- /dev/null +++ b/elisp/debian-el/debian-bug.el @@ -0,0 +1,2412 @@ +;;; debian-bug.el --- report a bug to Debian's bug tracking system + +;; Copyright (C) 1998, 1999 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2002, 2003, 2004 Peter S Galbraith +;; Copyright (C) 2005, 2006, 2007, 2008 Peter S Galbraith +;; Copyright (C) 2009, 2010 Peter S Galbraith + +;; Help texts from +;; http://www.debian.org/Bugs/Developer#severities +;; http://www.debian.org/Bugs/Developer#tags +;; http://www.debian.org/Bugs/pseudo-packages +;; Copyright 1999 Darren O. Benham, 1994-1997 Ian Jackson, +;; 1997 nCipher Corporation Ltd. + +;; Author (Up to version 1.7): Francesco Potortì +;; Maintainer from version 1.8 onwards: Peter S Galbraith +;; Keywords: debian, bug, reporter + +;; debian-bug.el 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. +;; +;; debian-bug.el 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: +;; +;; Useful commands provided by this mode: +;; +;; debian-bug - submit a bug report concerning a Debian package +;; debian-bug-web-bug - view a bug report on a web browser (via browse-url) +;; debian-bug-wnpp - submit a Work Needed on Prospective Package bug report +;; debian-bug-request-for-package +;; - shortcut for a WNPP bug type. +;; debian-bug-ITP - shortcut for a WNPP bug type +;; +;; debian-bug depends on either the bug package or the reportbug (>1.21) +;; package for best results. +;; +;; ---------------------------------------------------------------------------- +;;; Change log: +;; +;; V1.5 23sep99 Francesco Potortì +;; - V1.1 -> 1.5 versions had no changelogs; starting one now. +;; V1.6 and V1.7 by Francesco Potortì were unreleased. +;; V1.8 04aug01 Peter S Galbraith +;; - WNPP interface code added. I'm unsure whether the functions useful +;; only to Debian developpers should be in here. Perhaps split into a +;; second .el file bundled in dpkg-dev-el? +;; V1.9 10aug01 Peter S Galbraith +;; - gratuitous changes (sorry Francesco) while going through the code base: +;; document defvars, s/debian-bug-program/debian-bug-helper-program/, +;; s/debian-bug-init-program/debian-bug-helper-program-init/, +;; - updated list of pseudo-packages +;; V1.10 11aug01 Peter S Galbraith +;; Apply most of patch (made against v1.4!) from +;; Kim-Minh Kaplan , Dated 03 Oct 1999. +;; (mostly, it inserts the package version numbers in the completion obarray +;; eliminating the need to parse the status file later). +;; V1.11 11aug01 Peter S Galbraith +;; - Don't use external bug command when package name does not exist locally +;; (fixes an old bug). +;; - Add font-lock support (e.g. release-critical severities in red) +;; V1.12 13aug01 Peter S Galbraith +;; - generalize debian-bug-wnpp-email to debian-bug-use-From-address +;; - debian-bug-ITP and debian-bug-request-for-package shortcuts. +;; - Add menubar via minor-mode +;; -> set address to send to (submit, quiet, maintonly) +;; -> set/unset custom From header line. +;; -> set/unset X-Debbugs-CC header line. +;; -> change bug severity +;; -> add/change Tags +;; -> browse-url web interface to BTS +;; -> various help texts +;; -> customize +;; V1.13 14aug01 Peter S Galbraith +;; - Confirm when package is not in status file. +;; - Fix for reportbug >= 1.22 +;; V1.14 15aug01 Peter S Galbraith +;; - merge in wget BTS code from debian-changelog.el +;; - clarify help texts about maintonly and ftp.debian.org +;; - defaliases for -ITP and -RFP (closes: #108808) +;; - Add menu option for X-Debbugs-CC to myself. +;; - small format fixes. +;; V1.15 15aug01 Peter S Galbraith +;; - Change all address related menu comands to toggling radio switches. +;; V1.16 21sep01 Peter S Galbraith +;; - Temporary fix for XEmacs' lack of font-lock-add-keywords. +;; - Add template as done by reportbug for ITP and RFP wnpp bugs. +;; (closes: #111615) +;; V1.17 20oct01 Peter S Galbraith +;; - load poe for match-string-no-properties if using XEmacs. +;; - Use only one arg with format-time-string for XEmacs compatibility. +;; - After generating the bug list menu in XEmacs, remove both menus and add +;; them again. Otherwise the menu is not refreshed. (Closes: #111332) +;; V1.18 11nov01 Peter S Galbraith +;; - customize debian-bug-helper-program so bug isn't necessarily used first. +;; V1.19 11nov01 Peter S Galbraith +;; - debian-bug: change from "Package; title" from reporter-submit-bug-report +;; into "Package: title" (closes: #117976). +;; - debian-bug-From-address-init: recognize all env vars used by reportbug +;; and bug to set the From line. +;; - debian-bug-use-From-address: default to t if any of the above env vars +;; are set. I could also try to detect is debian-bug-From-address is +;; customized, but that's for another day. (closes #117855). +;; - debian-bug-prefill-report: don't add superfluous line at the beginning +;; of the bug report body (closes #117842). +;; V1.20 11dec01 Peter S Galbraith +;; - debian-bug: display message that we are fetching system info (which can +;; take a while). (Closes: #122033) +;; - debian-bug: fix function doc string (Closes: #121932 if Roland fixes +;; the corresponding autoload). +;; V1.21 11dec01 Peter S Galbraith +;; - debian-bug, debian-bug-wnpp: Use simpler 'reporter-compose-outgoing' +;; instead of 'reporter-submit-bug-report' +;; - debian-bug, debian-bug-wnpp: reset buffer to "*mail*" if mail-user-agent +;; is gnus-user-agent (Closes: #121532). +;; V1.22 11dec01 Peter S Galbraith +;; - menu: Implement most of Bill Wohler's excellent suggestions to improve +;; the main menu (Closes: #123476) +;; V1.23 12dec01 Peter S Galbraith +;; - use new option --template with reportbug for garanteed non-interactive +;; use of reportbug. The package must depend on reportbug >= 1.41.1 +;; (Closes: #122032) +;; V1.24 24Jan02 Peter S Galbraith +;; debian-bug-web-bugs: return all bugs for the source package. +;; V1.25 07Feb02 Peter S Galbraith +;; debian-bug-build-bug-menu: return all bugs for the source package. +;; V1.26 08Feb02 Peter S Galbraith +;; debian-bug-help-tags-text and debian-bug-help-severity-text: updated +;; debian-bug-tags-alist: Added "upstream" to list +;; V1.27 11Jul02 Peter S Galbraith +;; reset buffer to "*mail*" only when in buffer " *nttpd*" (Closes: #151717) +;; V1.28 30Jul02 Peter S Galbraith +;; added debian-bug-filename (Closes: 117036) +;; V1.29 02Augl02 Peter S Galbraith +;; Add a few functions from debian-changelog, since we are taking over +;; its duplicate commands. +;; New: debian-bug-web-this-bug +;; New: debian-bug-web-this-bug-under-mouse +;; V1.30 15Aug02 Peter S Galbraith +;; Kalle Olavi Niemitalo suggested the use of "toggle" buttons +;; instead of "radio" buttons, where appropriate (Closes: #156297). +;; V1.31 15Aug02 Peter S Galbraith +;; Remove erroneous [] brackets around WNPP tags (Closes: #156391). +;; V1.32 13Sep02 Peter S Galbraith +;; - Deal with reportbug 1.99.54 (or so) that adds MIME stuff to mail headers. +;; Patch from Brian Warner (Closes: #160750) +;; - debian-bug-prefill-report: Don't pass desired severity to reportbug +;; because it is interactive when high settings are passed. Set after +;; reportbug template is entered instead. (Closes: #159625) +;; V1.33 27Sep02 Peter S Galbraith +;; Split long bug menus, first into categories, then into number ranges. +;; (Closes: #161155) +;; V1.34 20Nov02 Peter S Galbraith +;; debian-bug-build-bug-menu: removed one character from the regexp for +;; the bug menu. I don't know if the web format changed, but +;; debian-bug-alist was short by the last number in its bug numbers. +;; V1.35 19Mar03 Peter S Galbraith +;; debian-bug-build-bug-menu: Adapted to change in BTS web page format. +;; Bugs were no longer found by the old regexp. +;; V1.36 19Mar03 Peter S Galbraith +;; debian-bug: Call proper debian-bug--set-custom-From, which will delete +;; an existing From line before inserting a new one. Closes: #184954. +;; debian-bug-prefill-report: Don't flake out on search if "\n\n" not +;; found. This might help with bug #165290, but I should really check +;; that reportbug doesn't fail. +;; debian-bug: Check if empty Subject field has trailing space. Should +;; fix bug #173040 and part of #177259. +;; V1.37 10Apr2003 Peter S Galbraith +;; - Switch priority of reportbug and bug, preferring reportbug. +;; - send to maintonly if priority wishlist or minor. Closes: #176429. +;; V1.38 14Apr2003 Peter S Galbraith +;; - Revert `send to maintonly if priority wishlist or minor' change. +;; maintonly is for mass filings. +;; - New buffer-local variable `debian-bug-open-alist' for open bugs. +;; This will be used for completion in debian-changelog-mode.el +;; - debian-bug: always build package list. Closes: #186338 +;; - Use executable-find. Patch contributed by Romain FRANCOISE +;; . Closes: #189605 +;; - New actions in Bugs list menu: can now read bug reports as file or Email! +;; - Apply checkdoc patch from Bill Wohler . Thanks! +;; - Byte-compilation cleanup. +;; - Added debian-bug-menu-preload-flag. +;; V1.39 22Apr2003 Peter S Galbraith +;; - debian-bug-alltags-alist: new variable for complete Tags list. +;; - debian-bug-help-control: new command for menu help for d-b-control +;; - Minor doc string fixes. +;; - renamed X-Debbugs-CC commands to simple CC, specifying the field to +;; use as an new argument. So it can be used in d-b-control. +;; V1.40 12May2003 Peter S Galbraith +;; - check if `debian-changelog-mode' is available as a feature, and not +;; simply the if the autoloaded are fboundp (which is always true). +;; V1.41 15May2003 Peter S Galbraith +;; - Add `confirmed' tag. +;; V1.42 23May2003 Matt Swift +;; debian-bug-prefill-report: announce error if reportbug gives empty +;; template. +;; V1.42 31May2003 Peter S Galbraith +;; Add `d-i', `ipv6' and `lfs' tags. +;; V1.43 01Sep2003 Peter S Galbraith +;; debian-bug-build-bug-menu: Create closing changlog entries in +;; debian-bug-open-alist cdr's. (Closes: #207852) +;; V1.44 03Sep2003 Peter S Galbraith +;; - Display help when prompting for package name and bug severity +;; (Closes: #200058) +;; - debian-bug-display-help: new defcustom. +;; V1.45 05Sep2003 Peter S Galbraith +;; - debian-bug-filename: Added File: in informational block. +;; - debian-bug-search-file: Added message about system call to dpkg. +;; - debian-bug-font-lock-keywords: added File: +;; - debian-bug: make it a front-end to `debian-bug-package' (the old +;; `debian-bug') and `debian-bug-filename' and make those non-interactive, +;; reducing the number of interactive commands. (Closes: #167214) +;; - checkdoc fixes. +;; V1.46 17Sep2003 Peter S Galbraith +;; - I think V1.43 added the # character before bug numbers in the menu +;; and broke the splitting-up of large bug categories. Fixed. +;; - bugs.debian.org added HTML "name" tags which I need to exclude from +;; titles. +;; V1.47 20Sep2003 Peter S Galbraith +;; - debian-bug-search-file: Use dlocate if available when filename is +;; given. thanks to Jeff Sheinberg (Closes: #211598). +;; V1.48 01Oct2003 Peter S Galbraith +;; - Make debian-bug accept P or F without a carriage return. +;; V1.49 05Oct2003 Peter S Galbraith +;; - Add tags "sarge-ignore" and "fixed-uptsream". +;; V1.50 09Oct2003 Peter S Galbraith +;; - Add debian-bug-rfc2047-decode-string. +;; V1.51 28Oct2003 Peter S Galbraith +;; - Send to maintonly if priority minor. Closes: #214242. +;; See http://www.debian.org/Bugs/Reporting.en.html: +;; "if a bug report is minor, for example, a documentation typo or a +;; trivial build problem, please adjust the severity appropriately and +;; send it to maintonly@bugs" +;; V1.52 27Nov2003 Kalle Olavi Niemitalo +;; - Contain debian-bug's cursor-in-echo-area to when it's needed so the +;; list of pseudo-packages can be scrolled. (Closes: #222332) +;; - debian-bug-package: Let M- and M- scroll the pseudo-package +;; list window by making _it_ the other window. (Closes: #222333) +;; V1.53 27Nov2003 Peter S Galbraith +;; - Add menu entry for "Archived Bugs for this package" and for +;; "Developer Page for This Package". Create debian-bug-web-developer-page. +;; V1.54 02Aug2004 Peter S Galbraith +;; - Add RFH tag to wnpp. +;; V1.54 11Nov2004 Camm Maguire +;; - debian-bug: Add "--list-cc=none" to call to reportbug after changes +;; in new version of reportbug. (Closes: #280780) +;; V1.55 05Jan2005 Kevin Ryde +;; - adds gnus support to debian-bug-get-bug-as-email, bringing the bug +;; messages up in a gnus group. (Closes: #288469) +;; V1.55 05Jan2005 Peter S Galbraith +;; debian-bug-package: skip over mml directives in new drafts. +;; Thanks to Luca Capello (Closes: #336466) +;; V1.56 03Nov2005 Peter S Galbraith +;; - debian-bug-prompt-bug-number: new function to prompt user for a bug +;; number using number under point if any. +;; - debian-bug-web-bug: use it. +;; - debian-bug-web-this-bug: deleted (no longer needed). +;; - debian-bug-get-bug-as-file: use it. +;; - debian-bug-get-bug-as-email: use it. +;; (Closes: #337233) +;; V1.57 03Nov2005 Peter S Galbraith +;; - Swap CC: for X-Debbugs-CC: in mail header (Closes: #208570) +;; V1.58 05Nov2005 Peter S Galbraith +;; - debian-bug-wnpp: skip over mml directives in new drafts. +;; Thanks to Luca Capello (Closes: #337659) +;; V1.59 14Nov2005 Peter S Galbraith +;; - Search for "^cc:" instead of simply "cc:" in Bug #208570 change. +;; V1.60 30May2006 Luca Capello +;; - Change the face of Tags: for experimental, (Closes: #357265) +;; V1.61 05Sep2006 Kevin Ryde +;; - word-at-point needs an autoload or a require statement (Closes: #384542) +;; V1.62 22Sep2006 Peter S Galbraith +;; - Added "Owner:" to ITP bugs. Thanks to Romain Francoise for bringing +;; this to my attention (Closes: #388747) +;; - Updated the list of valid tags. +;; V1.63 25Jul2007 Peter S Galbraith +;; - Adapt patch from Luca Capello for bug #431091 +;; V1.64 29Aug2007 Peter S Galbraith +;; - `debian-changelog-close-bug-statement' may not be bound (Closes: #440002) +;; Thanks to my friend Bill Wohler for finding this bug. +;; V1.65 02Sep2007 Peter S Galbraith +;; - Implement pacakge lookup on http://packages.debian.org/ +;; See http://bugs.debian.org/87725 +;; V1.66 24Sep2007 Luca Capello +;; - Add `debian-bug-get-bug-as-email-hook' and relative `run-hooks' +;; (Closes: #392475) +;; V1.67 09Sept2008 Peter S Galbraith +;; - Bug fix: "Bug submenus have vanished", thanks to Bill Wohler for the +;; report and to Camm Maguire for an initial patch (Closes: #463053). +;; V1.68 23Feb2009 Peter S Galbraith +;; - Bug fix: Adapted patch from Håkon Stordahl to +;; quote bug descriptions when building the bug menu. (Closes: #489786) +;; - Bug fix: Applied patch from Håkon Stordahl +;; for garbled Help buffer (Closes: #502426) +;; V1.69 13May2009 Peter S Galbraith +;; - Updated debian-bug-pseudo-packages (Closes: #526496) +;; - [PATCH] using the "maintainer mbox" instead of "mbox folder". +;; Thanks to Evgeny M. Zubok (Closes: #521571). +;; - Fix "incomplete Bugs menu again", thanks to A Mennucc (Closes: #524043). +;; V1.70 11Nov2009 Peter S Galbraith +;; - Add `debian-bug-bts-URL' variable +;; - Add `emacs-bug-web-bug', `emacs-bug-get-bug-as-email': +;; New commands to interface with Emacs BTS +;; V1.71 19Dec2009 Peter S Galbraith +;; - Emacs BTS moved to debbugs.gnu.org +;; V1.72 27Apr2010 Peter S Galbraith +;; - debian-bug-build-bug-menu takes optional SOURCE argument to create a +;; menu for source package. The problem comes from the BTS that no longer +;; finds source packages automatically, e.g. this won't work: +;; http://bugs.debian.org/cgi-bin/pkgreport.cgi?src=debian-el +;; but this is needed instead: +;; http://bugs.debian.org/cgi-bin/pkgreport.cgi?src=emacs-goodes-el +;; with the _real_ source package name. +;; V1.73 28Apr2010 H. Stordahl +;; As of version 4.12 reportbug has a --no-bug-script option which can +;; be used to work around bug #502317. +;; V1.74 07May2010 H. Stordahl +;; A better way to run bug scripts... (Closes #422506) +;; New functions: debian-bug-help-presubj, debian-bug-file-is-executable, +;; debian-bug-find-bug-script, debian-bug-script-sentinel, +;; debian-bug-run-bug-script, debian-bug-insert-bug-script-temp-file, +;; debian-bug-compose-report +;; Patch debian-bug-package to use them. +;; V1.74 07May2010 H. Stordahl +;; Support "Bugs:" control field for unofficial packages (Closes #222392) +;; New variable `debian-bug-bts-address' +;; New functions: +;; debian-bug-read-control-file-field +;; debian-bug-read-bug-control-file-field +;; debian-bug-find-bts-address +;; debian-bug-bts-mail +;; Patch debian-bug-prefill-report to use them +;; V1.75 13Mar2010 Peter S Galbraith +;; Updated `debian-bug-pseudo-packages'. +;; V1.76 30Jan2014 Peter S Galbraith +;; Finally applied patch from Sven Joachim to fix Bug #679390. Sorry! +;; V1.77 06Nov2016 Peter S Galbraith +;; - Updated tags +;; - Bug fix: "Missing ; in debian-bug.el first line header", thanks +;; to Antoine R. Dumont (Closes: #842566). +;;---------------------------------------------------------------------------- + +;;; Todo (Peter's list): +;; +;; - Add extra prompt for release-critical severities (e.g. "This indicates +;; the package is not suitable for release. Proceed?") +;; - Possibly add a pre-send-mail hook to check that all entries are +;; validated. +;; - Help texts need a top-level general one (say where to look them up, +;; and how to search by package, bug submitter, maintainer, etc) +;; - debian-bug-wnpp accepts empty package name! +;; - debian-bug-wnpp doesn't get a Bugs menu or web lookup. +;; -> should lookup specified package to [O] and [ITO] ? +;; -> or list all bugs for wnpp? +;; - add debian-bug-pseudo-package (with completion on those only, possibly +;; with description) + +;;; User customizable variables: + +;;; Code: +(defgroup debian-bug nil "Debian Bug report helper" + :group 'tools + :prefix "debian-bug-") + +(defcustom debian-bug-display-help t + "Display help text when prompting for package name and bug severity." + :group 'debian-bug + :type 'boolean) + +(defcustom debian-bug-helper-program nil + "Helper program to use to generate bug report background info. +Possible values are 'bug, 'reportbug or nil (for neither). +If not customized, it will get set to at runtime to 'reportbug if the command +exists, or else to 'bug if that command exists, or else simply parse the +status file." + :group 'debian-bug + :type '(radio (const :tag "reportbug" reportbug) + (const :tag "bug" bug) + (const :tag "set at runtime" nil))) + +(defcustom debian-bug-use-From-address + (or (getenv "DEBEMAIL") ; reportbug + (getenv "REPORTBUGEMAIL") ; reportbug + (getenv "EMAIL")) ; reportbug and bug + "Insert a custom From line in the bug report header. +Use it to specify what email your bugs will be archived under." + :group 'debian-bug + :type 'boolean) + +(defcustom debian-bug-download-directory "~/" + "Directory for mbox file downloads from the Debian BTS." + :group 'debian-bug + :type 'directory) + +(defcustom debian-bug-mh-folder "+debian-bug" + "The folder to put all bug folders into when using MH-E (7.3 or better)." + :group 'debian-bug + :type '(choice (string :tag "Folder name") + (const :tag "Don't use a folder" nil))) + +;;; Not implemented yet. +;; (defcustom debian-bug-create-package-directories-flag nil +;; "Non-nil means to create a directory for each package. +;; For rmail, this means a directory beneath `debian-bug-download-directory'. +;; For MH-E, this means a folder beneath `debian-bug-mh-folder'." +;; :group 'debian-bug +;; :type 'boolean) + +;; This function is from emacs/lisp/calendar/icalendar.el, +;; necessary to replace "%s" with the bug number in +;; `debian-changelog-close-bug-statement' +(defsubst debian-bug--rris (&rest args) + "Replace regular expression in string. +Pass ARGS to `replace-regexp-in-string' (GNU Emacs) or to +`replace-in-string' (XEmacs)." + ;; XEmacs: + (if (fboundp 'replace-in-string) + (save-match-data ;; apparently XEmacs needs save-match-data + (apply 'replace-in-string args)) + ;; Emacs: + (apply 'replace-regexp-in-string args))) + +(defvar debian-bug-minor-mode nil) +(defvar debian-bug-minor-mode-map nil + "Keymap for `debian-bug' minor mode.") +(if debian-bug-minor-mode-map + nil + (setq debian-bug-minor-mode-map (make-sparse-keymap))) + +(if (not (fboundp 'match-string-no-properties)) + (load "poe" t t)) ;XEmacs21.1 doesn't autoload this + +;;; Guess From address initial value (if not set via customize) +(defun debian-bug-From-address-init () + "Return email to use for the From: line of the BTS email. +The full name is from the environment variable DEBFULLNAME or else the +variable `user-full-name'. +The email address is from the environment variable DEBEMAIL or EMAIL, +or else the `user-mail-address' variable." + (let ((fullname (or (getenv "DEBFULLNAME") + (getenv "DEBNAME") ; reportbug + (getenv "NAME") ; reportbug + (user-full-name))) + (mailing-address + (or (getenv "DEBEMAIL") ; reportbug + (getenv "REPORTBUGEMAIL") ; reportbug + (getenv "EMAIL") ; reportbug and bug + (and (boundp 'user-mail-address) user-mail-address) + (and (fboundp 'user-mail-address) (user-mail-address))))) + (cond + ((and fullname mailing-address) + (format "%s <%s>" fullname mailing-address)) + (mailing-address + mailing-address) + (t + nil)))) + +(defcustom debian-bug-From-address (debian-bug-From-address-init) + "Email address to use for the From: and CC: lines of Debian bug reports. +The default value is obtained from the function `debian-bug-From-address-init'." + :group 'debian-bug + :type 'string) + +(defcustom debian-bug-always-CC-myself t + "Insert a CC line to myself in the bug report header. +Will only actually do it if the variable `debian-bug-From-address' is set." + :group 'debian-bug + :type 'boolean) + +;;(defvar debian-bug-menu-action) +;;(defvar debian-bug-menu-action-default) +;;(defun debian-bug-menu-action-set (symbol value) +;; "Set SYMBOL to VALUE for +;; (set-default symbol value) +;; (setq-default debian-bug-menu-action debian-bug-menu-action-default) +;; (setq debian-bug-menu-action debian-bug-menu-action-default)) + +(defcustom debian-bug-menu-action-default 'browse + "Default action enabled at startup in Bugs menu-bar." + :group 'debian-bug +;; :set 'debian-bug-menu-action-set + :set (lambda (symbol value) + (set-default symbol value) + (setq-default debian-bug-menu-action debian-bug-menu-action-default) + (setq debian-bug-menu-action debian-bug-menu-action-default)) + :type '(radio (const :tag "Browse" browse) + (const :tag "Read as File" readfile) + (const :tag "Read as Email" email))) + +(defvar debian-bug-menu-action debian-bug-menu-action-default + "Action to take when selecting a bug number from the Bugs menu-bar.") +(make-variable-buffer-local 'debian-bug-menu-action) + +(defcustom debian-bug-menu-preload-flag nil + "Non-nil means to fetch bug list from the web and populate Bugs menu. +Otherwise, simply use the menu entry to generate it." + :group 'debian-bug + :type 'boolean) + +;; hooks +(defcustom debian-bug-get-bug-as-email-hook nil + "Hook run when getting a bug through `mail-user-agent'." + :group 'debian-bug + :type 'hook) + + +;;; Internal variables: + +(defvar debian-bug-bts-URL "http://bugs.debian.org/cgi-bin/bugreport.cgi?" + "URL of the Bug Tracking System to query.") + +(defvar debian-bts-control-for-emacs nil + "Whether `debian-bts-control' is being called for Emacs BTS.") + +(defvar debian-bug-mail-address + "Debian Bug Tracking System " + "Email address that bugs are sent to.") + +(defvar debian-bug-mail-quiet-address + "Debian Bug Tracking System " + "Address to use to send to the BTS but not forward to the maintainer.") + +(defvar debian-bug-mail-maintonly-address + "Debian Bug Tracking System " + "Address to use to send to the maintainer but not forward to the BTS.") + +(defvar debian-bug-status-file "/var/lib/dpkg/status" + "Debian installed package status file. +Used to get list of packages for prompt completion, and for report generation +when the shell commands \"bug\" and \"reportbug\" are not available") + +(defvar debian-bug-severity-alist + '(("critical") ("grave") ("serious") ("important") + ("normal") ("minor") ("wishlist")) + "Alist of possible bug severities used for prompt completion.") + +(defvar debian-bug-tags-alist + '(("patch") ("security") ("upstream")) +;;'(("patch") ("security") ("upstream") ("potato") ("woody") ("sarge") ("sid")) + "Alist of valid Tags aimed at Debian users. +The complete list of valid tags is longer, but the others are for use by +Debian maintainers.") + +(defvar debian-bug-alltags-alist + '(("patch") ("wontfix") ("moreinfo") ("unreproducible") ("help") ("pending") + ("fixed") ("fixed-in-experimental") ("fixed-upstream") ("security") + ("upstream") ("confirmed") ("d-i") ("ipv6") ("lfs") ("l10n") ("potato") + ("woody") ("sarge") ("sarge-ignore") ("etch") ("etch-ignore") ("lenny") + ("squeeze") ("wheezy") ("jessie") ("sid") ("experimental")) + "Alist of all valid Tags, aimed at Debian developpers.") + +(defvar debian-bug-pseudo-packages + '("base" "bugs.debian.org" "buildd.debian.org" "buildd.emdebian.org" + "cdimage.debian.org" "cdrom" "debian-i18n" "debian-maintainers" + "ftp.debian.org" "general" "installation-reports" "lists.debian.org" + "mirrors" "nm.debian.org" "press" "project" "qa.debian.org" "release-notes" + "release.debian.org" "security-tracker" "security.debian.org" + "snapshot.debian.org" "tech-ctte" "upgrade-reports" "wiki.debian.org" + "wnpp" "www.debian.org") + + "List of Debian pseudo-packages available for completion. +See http://www.debian.org/Bugs/pseudo-packages") + +(defvar debian-bug-packages-obarray nil + "List of Debian packages from status file used for completion.") + +(defvar debian-bug-packages-date nil + "Last modification time of status file used for internal package list. +Used to determine if internal list is uptodate.") + +(defvar debian-bug-package-name nil + "Buffer-local variable holding the package name for this submission.") +(make-variable-buffer-local 'debian-bug-package-name) + +(defvar debian-bug-bts-address "bugs.debian.org" + "Name of BTS to which the bug report will be submitted.") +(make-variable-buffer-local 'debian-bug-bts-address) + +(defvar debian-bug-easymenu-list nil + "Holds the dynamically built easymenu list.") +(defvar debian-bug-bugs-menu nil + "Buffer local Bugs menu.") +(make-variable-buffer-local 'debian-bug-bugs-menu) +(defvar debian-bug-alist nil + "Buffer local alist of bug numbers (and description) for this package.") +(make-variable-buffer-local 'debian-bug-alist) +(defvar debian-bug-open-alist nil + "Buffer local alist of open bug numbers (and description) for this package.") +(make-variable-buffer-local 'debian-bug-open-alist) + +(defalias 'report-debian-bug 'debian-bug) + +;;; Functions: +(autoload 'reporter-compose-outgoing "reporter") +(autoload 'mail-header-end "sendmail") +(autoload 'match-string-no-properties "poe") ;XEmacs +(autoload 'debian-changelog-suggest-package-name "debian-changelog-mode") +(autoload 'debian-changelog-close-bug "debian-changelog-mode") +(autoload 'mh-find-path "mh-utils") +(autoload 'mh-expand-file-name "mh-utils") +(autoload 'mh-visit-folder "mh-e") +(autoload 'mh-exec-cmd-quiet "mh-utils") +(autoload 'mh-inc-folder "mh-e") + +(defun debian-bug-intern (pair) + "Simple function to intern PAIR of car cdr in `debian-bug-packages-obarray'." + (set (intern (car pair) debian-bug-packages-obarray) (cdr pair))) + +(defun debian-bug-fill-packages-obarray () + "Build `debian-bug-packages-obarray' and return its value. +The obarray associates each package with the installed version of the package." + (if (not (and (vectorp debian-bug-packages-obarray) + (equal debian-bug-packages-date + (nth 5 (file-attributes debian-bug-status-file))))) + (let ((case-fold-search t) + (packages (length debian-bug-pseudo-packages)) + (real-pkgs '()) + this-pkg this-ver) + (message "Building list of installed packages...") + (with-temp-buffer + (insert-file-contents-literally debian-bug-status-file) + (while (not (eobp)) + (cond ((looking-at "$") + (if (and this-pkg this-ver) + (setq real-pkgs (cons (cons this-pkg this-ver) real-pkgs) + packages (1+ packages))) + (setq this-pkg nil + this-ver nil)) + ((looking-at "Package *: *\\([^ ]*\\)$") + (setq this-pkg (match-string 1))) + ((looking-at "Version *: *\\([^ ]*\\)$") + (setq this-ver (match-string 1)))) + (forward-line))) + (setq debian-bug-packages-obarray + (make-vector (1- (ash 4 (logb packages))) 0) + debian-bug-packages-date + (nth 5 (file-attributes debian-bug-status-file))) + (mapcar 'debian-bug-intern (mapcar 'list debian-bug-pseudo-packages)) + (mapcar 'debian-bug-intern real-pkgs) + (message "Building list of installed packages...done"))) + (if debian-bts-control-for-emacs + '(("bzr") ("debbugs.gnu.org") ("gnus") ("octave") + ("other") ("rmail")) + debian-bug-packages-obarray)) + +(defun debian-bug-check-for-program (program) + "Check if PROGRAM is installed on the system. +Done by calling `executable-find' or the external \"which\" utility." + (if (fboundp 'executable-find) + (executable-find program) + (zerop (call-process "which" nil nil nil program)))) + +(defun debian-bug-helper-program () + "Return helper program found on system. +This can be removed at some point since `bug' is not released in sarge." + (or debian-bug-helper-program + (cond + ((debian-bug-check-for-program "reportbug") + 'reportbug) + ((debian-bug-check-for-program "bug") + 'bug) + (t + 'none)))) + +(defun debian-bug-read-control-file-field (package field) + "In the control file of PACKAGE, return the value of FIELD. +This is achieved by parsing the output of dpkg -s. If the field +doesn't exist, nil is returned." + (let ((case-fold-search t)) + (with-temp-buffer + (call-process "dpkg" nil '(t nil) nil "-s" package) + (goto-char (point-min)) + (if (re-search-forward + (concat "^" field " *: *\\(.+\\)$") nil t) + (match-string 1))))) + +(defun debian-bug-read-bug-control-file-field (package field) + "In the bug control file of PACKAGE, return the value of FIELD if it exists. +Otherwise nil is returned." + (let ((control (concat "/usr/share/bug/" package "/control")) + (case-fold-search t)) + (if (file-readable-p control) + (with-temp-buffer + (insert-file-contents-literally control) + (goto-char (point-min)) + (if (re-search-forward + (concat "^" field " *: *\\(.+\\)$") nil t) + (match-string 1)))))) + +(defun debian-bug-find-bts-address (package) + "Return address of BTS where bug reports on PACKAGE should be submitted. +This is specified by either the Bugs field in the control file for PACKAGE, +or the Send-To field in the file /usr/share/bug/PACKAGE/control. If neither +of these fields have been specified, the address of the Debian BTS is +returned. Note that the address returned can be either a complete e-mail +address or the host address of the BTS. In the latter case the address +must be expanded, by prepending \"submit\", \"maintonly\" or \"quiet\", as +appropriate, followed by the at-sign, before it can be used to submit bug +reports." + (let ((bugs-field (debian-bug-read-control-file-field + package "Bugs")) + (send-to-field (debian-bug-read-bug-control-file-field + package "Send-To"))) + (cond + ((and bugs-field (string-match "^\\(debbugs://\\|mailto:\\)\\(.+\\)$" + bugs-field)) + (match-string 2 bugs-field)) + (send-to-field send-to-field) + (t "bugs.debian.org")))) + +(defun debian-bug-bts-mail (type bts-address) + "Return the complete e-mail address which should be used to submit the bug. +The TYPE parameter is typically either of the strings \"submit\", +\"quiet\" or \"maintonly\". However, if BTS-ADDRESS is already a +complete e-mail address, the TYPE parameter is ignored, and this +function simply returns BTS-ADDRESS." + (if (string-match "@" bts-address) + bts-address + (concat type "@" bts-address))) + +(defun debian-bug-prefill-report (package severity) + "Prefill bug report for PACKAGE at SEVERITY, calling bug or reportbug." + (cond + ;; bug + ((and (eq (debian-bug-helper-program) 'bug) + (intern-soft package debian-bug-packages-obarray)) + (save-excursion + (call-process "bug" nil '(t t) nil "-p" "-s" "" "-S" severity package)) + (forward-line 4)) + + ;; reportbug + ((eq (debian-bug-helper-program) 'reportbug) + (save-excursion + (call-process "reportbug" nil '(t t) nil + "--template" "-T" "none" "-s" "none" "-S" "normal" "-b" + "--list-cc=none" "--no-bug-script" + "-q" package) + (debian-bug--set-severity severity)) + ;; delete the mail headers, leaving only the BTS pseudo-headers + (delete-region + (point) + (or (search-forward "\n\n" nil t) + ;; Fix from Matt Swift + (error "Reportbug did not produce expected output! Bailing out. +Reportbug may have sent an empty report!"))) + ;; and skip forward to them + (search-forward "\n\n" nil t) + ) + + ;; neither reportbug nor bug + (t + (insert + "Package: " (or (debian-bug-read-bug-control-file-field + package "Submit-As") + package) + "\nVersion: " (let ((sym (intern-soft package debian-bug-packages-obarray))) + (or (if (boundp sym) (symbol-value sym)) + (format-time-string "+N/A; reported %Y-%m-%d"))) + "\nSeverity: " severity + "\n\n\n\n-- System Information" + "\nDebian Release: ") + + (if (file-readable-p "/etc/debian_version") + (forward-char (cadr + (insert-file-contents-literally "/etc/debian_version"))) + (insert "unknwown\n")) + + (insert "Kernel Version: ") + (call-process "uname" nil '(t t) nil "-a") + (forward-line -5)))) + +(defun debian-bug-help-presubj (package) + "Display contents of /usr/share/bug/PACKAGE/presubj." + (let ((presubj (concat "/usr/share/bug/" package "/presubj"))) + (if (file-readable-p presubj) + (with-output-to-temp-buffer "*Help*" + (with-current-buffer "*Help*" + (insert-file-contents presubj)))))) + +(defun debian-bug-file-is-executable (file) + "Return non-nil if FILE is executable. Otherwise nil is returned." + (and + (file-regular-p file) + (file-executable-p file))) + +(defun debian-bug-find-bug-script (package) + "Return the full path name of the bug script of PACKAGE. +If such script exists, otherwise nil is returned." + (let ((script-alt1 (concat "/usr/share/bug/" package "/script")) + (script-alt2 (concat "/usr/share/bug/" package))) + (cond + ((debian-bug-file-is-executable script-alt1) script-alt1) + ((debian-bug-file-is-executable script-alt2) script-alt2)))) + +(defun debian-bug-script-sentinel + (process event package severity subject filename + bug-script-temp-file win-config) + "This function is the process sentinel for bug script processes. +When called, if the process has terminated, this function cleans +up the buffer used by the process and proceeds to the next step in the +bug reporting process by calling `debian-bug-compose-report'. Note that +this process sentinel is different from regular process sentinels in +that it requires more arguments. So, it cannot be assigned to a process +with `set-process-sentinel' directly, but requires some tweaking instead." + (if (memq (process-status process) '(exit signal)) + (let* ((bug-script-buffer + (process-buffer process)) + (bug-script-buffer-empty + (= (buffer-size bug-script-buffer) 0))) + + ;; Call the process sentinel provided by the term module, to + ;; clean up the terminal buffer. The sentinel will print a + ;; message in the buffer, so we have been careful to check + ;; whether the buffer is empty above, before this call. + ;; Note, XEmacs' term module doesn't provide this sentinel. + (if (fboundp 'term-sentinel) + (term-sentinel process event)) + + ;; The reportbug program doesn't seem to care about the exit + ;; status of a bug script, so we won't do it either. + ;; (if (/= (process-exit-status process) 0) + ;; (error (concat "Error occured while collecting" + ;; " information about the package"))) + + ;; If there is a window displaying the bug script buffer, + ;; restore the original window configuration, because it + ;; might have been changed when the bug script buffer was + ;; displayed. Otherwise, if the buffer isn't visible, + ;; assume that the window configuration hasn't changed, so + ;; don't restore anything. + (if (get-buffer-window bug-script-buffer) + (set-window-configuration win-config)) + + ;; If the process output buffer still exists, kill it if it's + ;; empty, otherwise bury it. + (if (buffer-name bug-script-buffer) + (if bug-script-buffer-empty + (kill-buffer bug-script-buffer) + (bury-buffer bug-script-buffer))) + + (debian-bug-compose-report package severity subject filename + bug-script-temp-file)))) + +(defun debian-bug-run-bug-script (package severity subject filename) + "Run a script, if provided by PACKAGE, to collect information. +The information about the package which should be supplied with +the bug report, and then proceed to the next step in the bug +reporting process by calling `debian-bug-compose-report'." + (let ((handler "/usr/share/reportbug/handle_bugscript") + (bug-script (debian-bug-find-bug-script package))) + (if (and bug-script + (debian-bug-file-is-executable handler) + (if (featurep 'xemacs) + (or (featurep 'term) (load "term" 'noerror)) + (require 'term nil 'noerror))) + (let ((bug-script-buffer + (get-buffer-create "*debian-bug-script*")) + (bug-script-temp-file + (cond ((fboundp 'make-temp-file) ;; XEmacs doesn't know + (make-temp-file "debian-bug-")) ;; make-temp-file. + ((fboundp 'temp-directory) + (make-temp-name (expand-file-name + "debian-bug-" (temp-directory)))) + (t (error "Cannot create temporary file")))) + (bug-script-process) + + ;; XEmacs' term module doesn't set the appropriate + ;; coding system for process output from term-exec. + ;; Thus the following workaround, otherwise the terminal + ;; displayed by XEmacs can get messed up. + (coding-system-for-read 'binary)) + + (message (concat "Collecting information about the package." + " This may take some time.")) + (with-current-buffer bug-script-buffer + (erase-buffer) + (term-mode) + (term-exec bug-script-buffer "debian-bug-script" handler nil + (list bug-script bug-script-temp-file)) + (setq bug-script-process + (get-buffer-process bug-script-buffer)) + + ;; The process sentinel should handle process termination. + ;; Note that we need to pass more information to the + ;; process sentinel than just the process object and event + ;; type. Ideally, the process property list seems suitable + ;; for this purpose, but that is only supported in GNU + ;; Emacs 22 and later. So, a hack is used to construct the + ;; process sentinel with the required data on the fly. + ;; However, I suspect there are better ways to do this, + ;; perhaps to use lexical-let. + (set-process-sentinel + bug-script-process + (list 'lambda '(process event) + (list 'debian-bug-script-sentinel 'process 'event + package severity subject filename + bug-script-temp-file + (current-window-configuration)))) + + (term-char-mode) + + ;; The function set-process-query-on-exit-flag is only + ;; available in GNU Emacs version 22 and later. + (if (fboundp 'set-process-query-on-exit-flag) + (set-process-query-on-exit-flag bug-script-process nil))) + + ;; Delay switching to the process output buffer by waiting + ;; for output from the process, the process to terminate or + ;; 200 seconds, because ideally we don't want to display the + ;; buffer unless the process will be requesting input, but + ;; it's no way to tell that in advance. If the process + ;; prints to stdout, it's likely it will be expecting input, + ;; so we display the buffer. If the process terminates with + ;; no output, we simply don't do anything; the process + ;; sentinel will kill the buffer, and proceed, upon process + ;; termination. + (accept-process-output bug-script-process 200) + + ;; Short wait required here for the process-status to be + ;; updated. (Maybe a bug in Emacs?) + (sleep-for 0.050) + (if (not (memq (process-status bug-script-process) + '(exit signal))) + (switch-to-buffer-other-window bug-script-buffer))) + + (debian-bug-compose-report package severity subject filename)))) + +(defun debian-bug-insert-bug-script-temp-file (temp-file) + "Insert the output from the bug script, if any, into the current buffer." + (when (and temp-file (file-readable-p temp-file)) + (save-excursion + (next-line 1) + (insert "\n") + (insert "-- Package-specific info:\n") + (let ((beg (point)) + (end (+ (point) + (nth 1 (insert-file-contents temp-file))))) + (save-restriction + (narrow-to-region beg end) + (goto-char (point-max)) + (beginning-of-line) + (when (not (looking-at "$")) + (end-of-line) + (insert "\n")) + (when (or (and (boundp 'mml-mode) mml-mode) + (memq mail-user-agent '(mh-e-user-agent + message-user-agent + gnus-user-agent))) + (mml-quote-region (point-min) (point-max)) + (goto-char (point-min)) + (insert "<#part type=\"text/plain\" disposition=attachment" + " description=\"Bug script output\">\n") + (goto-char (point-max)) + (insert "<#/part>\n")))) + (delete-file temp-file)))) + +(defun debian-bug-package (&optional package filename) + "Submit a Debian bug report about PACKAGE." + (if (or (not package) (string= "" package)) + (save-window-excursion + (when debian-bug-display-help + (debian-bug-help-pseudo-packages) + ;; This lets M- and M- scroll the pseudo-package list + ;; window by making _it_ the other window. + (if (get-buffer-window "*Help*") + (select-window (get-buffer-window "*Help*")))) + (setq package (completing-read + "Package name: " + (debian-bug-fill-packages-obarray) + nil nil nil nil (current-word))))) + (if (string= package "wnpp") + (debian-bug-wnpp) + (debian-bug-fill-packages-obarray) + (if (and (not (intern-soft package debian-bug-packages-obarray)) + (not (y-or-n-p + "Package does not appear to be installed. Continue? "))) + (error "Quitting")) + (let ((severity (save-window-excursion + (if debian-bug-display-help + (debian-bug-help-severity)) + (completing-read "Severity (default normal): " + debian-bug-severity-alist + nil t nil nil "normal"))) + (subject (save-window-excursion + (debian-bug-help-presubj package) + (read-string "(Very) brief summary of problem: ")))) + (debian-bug-run-bug-script package severity subject filename)))) + +(defun debian-bug-compose-report + (package severity subject filename &optional bug-script-temp-file) + "Compose the initial contents of the bug report and present it in a buffer. +The buffer will be completed by the user." +;;; (require 'reporter) + (reporter-compose-outgoing) + (if (and (equal mail-user-agent 'gnus-user-agent) + (string-equal " *nntpd*" (buffer-name))) + (set-buffer "*mail*")) ; Bug in emacs21.1? Moves to " *nntpd*" + (goto-char (point-min)) + (when (re-search-forward "^cc:" nil t) + (delete-region (match-beginning 0)(match-end 0)) + (insert "X-Debbugs-CC:")) + (setq debian-bug-bts-address + (debian-bug-find-bts-address package)) + (goto-char (point-min)) + (cond + ((re-search-forward "To: " nil t) + (insert debian-bug-mail-address)) + ((re-search-forward "To:" nil t) + (insert " " debian-bug-mail-address)) + (t + (insert "To: " debian-bug-mail-address))) + (if (string-equal severity "minor") + (debian-bug--set-bts-address + (debian-bug-bts-mail "maintonly" debian-bug-bts-address)) + (debian-bug--set-bts-address + (debian-bug-bts-mail "submit" debian-bug-bts-address))) + (goto-char (point-min)) + (cond + ((re-search-forward "Subject: " nil t) + (insert package ": " subject)) + ((re-search-forward "Subject:" nil t) + (insert " " package ": " subject)) + (t + (insert "Subject: " package ": " subject))) + (require 'sendmail) + (goto-char (mail-header-end)) + (forward-line 1) + (if (looking-at "^<#secure") ;Skip over mml directives + (forward-line 1)) + (message "Getting package information from reportbug...") + (debian-bug-prefill-report package severity) + (message "Getting package information from reportbug...done") + (if debian-bug-use-From-address + (debian-bug--set-custom-From)) + (if debian-bug-always-CC-myself + (debian-bug--set-CC debian-bug-From-address "X-Debbugs-CC:")) + (when filename + (forward-char -1) + (insert "File: " filename "\n") + (forward-char 1)) + (debian-bug-insert-bug-script-temp-file bug-script-temp-file) + (set-window-start (selected-window) (point-min) t) + (setq debian-bug-package-name package) + (debian-bug-minor-mode 1) + (set-buffer-modified-p nil)) + +;;; --------- +;;; WNPP interface by Peter S Galbraith , August 4th 2001 +(defvar debian-bug-wnpp-alist + '(("Intent to Package [ITP]" . "ITP") + ("Orphaned [O]". "O") + ("Request for Adoption [RFA]" . "RFA") + ("Request For Package [RFP]" . "RFP") + ("Request For Help [RFH]" . "RFH")) + "Alist of WNPP possible bug reports.") + +(defvar debian-bug-wnpp-severities + '(("ITP" . "wishlist") + ("O". "normal") + ("RFA" . "normal") + ("RFP" . "wishlist") + ("RFH" . "normal")) + "Bug severeties for each WNPP bug type.") + +;;;###autoload +(defun debian-bug-wnpp (&optional action) + "Submit a WNPP bug report to Debian. +Optional argument ACTION can be provided in programs." + (interactive + (list (completing-read + "Action: (Press TAB) " debian-bug-wnpp-alist nil t nil))) + (if (or (not action) (string= action "")) + (setq action (completing-read + "Action: (Press TAB) " debian-bug-wnpp-alist nil t nil))) + (if (or (not action) (string= action "")) + (error "Nothing to do")) + (require 'reporter) + (debian-bug-fill-packages-obarray) + (let* ((tag (cdr (assoc action debian-bug-wnpp-alist))) + (severity (cdr (assoc tag debian-bug-wnpp-severities))) + (package + (completing-read + (cond ((string-equal action "Intent to Package [ITP]") + "Proposed package name: ") + ((string-equal action "Request For Package [RFP]") + "Requested package name: ") + (t + "package name: ")) + debian-bug-packages-obarray nil nil nil)) + ;;FIXME: Should fetch description from system for "[O]" and "[ITO]" + (description (read-string "Very short package description: ")) + (CC-devel (y-or-n-p "CC bug report to debian-devel? "))) + (require 'reporter) + (reporter-compose-outgoing) + (if (and (equal mail-user-agent 'gnus-user-agent) + (string-equal " *nntpd*" (buffer-name))) + (set-buffer "*mail*")) ; Bug in emacs21.1? Moves to " *nntpd*" + (goto-char (point-min)) + (if (re-search-forward "To:" nil t) + (insert " " debian-bug-mail-address) + (insert "To: " debian-bug-mail-address)) + (require 'sendmail) + (goto-char (mail-header-end)) + (forward-line 1) + (if (looking-at "^<#secure") ;Skip over mml directives + (forward-line 1)) + (save-excursion + (goto-char (point-min)) + (if debian-bug-use-From-address + (debian-bug--set-custom-From)) + (if debian-bug-always-CC-myself + (debian-bug--set-CC debian-bug-From-address "X-Debbugs-CC:")) + (if (re-search-forward "Subject: " nil t) + (insert (format "%s: %s -- %s" tag package description)) + (re-search-forward "Subject:" nil t) + (insert (format " %s: %s -- %s" tag package description))) + (if CC-devel + (debian-bug--set-CC "debian-devel@lists.debian.org" + "X-Debbugs-CC:"))) + (insert "Package: wnpp\n") + (when (and (string-equal tag "ITP") + debian-bug-From-address) + (insert (format "Owner: %s\n" debian-bug-From-address))) + (insert (format "Severity: %s\n\n" severity)) + (when (or (string-equal tag "ITP") + (string-equal tag "RFP")) + (insert +;;; "< Enter some information about the package, upstream URL and license here. >\n" + "* Package name : " package "\n" + " Version : \n" + " Upstream Author : \n" + "* URL or Web page : \n" + "* License : \n" + " Description : " description "\n") + (forward-line -1)) + (set-window-start (selected-window) (point-min) t) + (debian-bug-wnpp-minor-mode 1) + (set-buffer-modified-p nil))) + +;;;###autoload +(defun debian-bug-request-for-package () + "Shortcut for `debian-bug-wnpp' with RFP action." + (interactive) + (debian-bug-wnpp "Request For Package [RFP]")) +(defalias 'debian-bug-RFP 'debian-bug-request-for-package) + +;;;###autoload +(defun debian-bug-intent-to-package () + "Shortcut for `debian-bug-wnpp' with ITP action (for Debian developers)." + (interactive) + (debian-bug-wnpp "Intent to Package [ITP]")) +(defalias 'debian-bug-ITP 'debian-bug-intent-to-package) + +;;; font-lock by Peter S Galbraith , August 11th 2001 +(defvar debian-bug-font-lock-keywords + '(("^ *\\(Package:\\) *\\([^ ]+\n\\)?" + (1 font-lock-keyword-face) + (2 font-lock-type-face nil t)) + ("^ *\\(Owner:\\) *\\(.+\n\\)?" + (1 font-lock-keyword-face) + (2 font-lock-type-face nil t)) + ("^ *\\(File:\\) *\\([^ ]+\n\\)?" + (1 font-lock-keyword-face) + (2 font-lock-type-face nil t)) + ("^ *\\(Version:\\) *\\([^ \n]+\n\\)?" + (1 font-lock-keyword-face) + (2 font-lock-type-face nil t)) + ("^ *\\(Tags:\\).*\\(\\(patch\\|experimental\\)\\)" + (1 font-lock-keyword-face) + (2 font-lock-type-face nil t)) + ("^ *\\(Tags:\\).*\\(security\\)" + (1 font-lock-keyword-face) + (2 font-lock-warning-face nil t)) + ("^ *\\(Severity:\\) *\\(\\(critical\\|grave\\|serious\\)\\|\\(important\\)\\|\\(normal\\)\\|\\(\\(minor\\)\\|\\(wishlist\\)\\)\\)" + (1 font-lock-keyword-face) + (3 font-lock-warning-face nil t) + (4 font-lock-function-name-face nil t) + (5 font-lock-type-face nil t) + (6 font-lock-string-face nil t)) + ("^Subject: \\[\\(ITP\\|O\\|RFA\\|RFP\\)\\]" + (1 font-lock-warning-face t t))) + "Regexp keywords to fontify `debian-bug' reports.") + +;;; --------- +;;; Menu-bar via minor-mode +;; Peter S Galbraith , August 12th 2001 + +(defun debian-bug--is-custom-From () + "Return t if first line begins in From:." + (save-excursion + (goto-char (point-min)) + (looking-at "^From:"))) + +(defun debian-bug--unset-custom-From () + "Remove From line in the mail header." + (save-excursion + (goto-char (point-min)) + (let ((header-end (re-search-forward "^-*$" nil t))) + (goto-char (point-min)) + (when (re-search-forward "^From:" header-end t) + (delete-region (progn (beginning-of-line)(point)) + (progn (forward-line 1)(point))))))) + +(defun debian-bug--set-custom-From () + "Set a From line using the `debian-bug-From-address' variable." + (if (not debian-bug-From-address) + (error "Variable debian-bug-From-address is unset, please customize it") + (save-excursion + (goto-char (point-min)) + (debian-bug--unset-custom-From) + (insert "From: " debian-bug-From-address "\n")))) + +(defun debian-bug--toggle-custom-From () + "Toggle the From line using the `debian-bug-From-address' variable." + (if (debian-bug--is-custom-From) + (debian-bug--unset-custom-From) + (debian-bug--set-custom-From))) + +(defun debian-bug--is-CC (address field) + "Return t if ADDRESS is present in FIELD." + (save-excursion + (goto-char (point-min)) + (let ((case-fold-search t)) + (re-search-forward + (concat "^" field ".*" (regexp-quote address)) nil t)))) + +(defun debian-bug--remove-CC (address field &optional nocleanup) + "Remove ADDRESS from FIELD. +Non-nil optional argument NOCLEANUP means remove empty field." + (save-excursion + (goto-char (point-min)) + (if (or (re-search-forward (concat "^" field ".*\\(" + (regexp-quote address) ", \\)") nil t) + (re-search-forward (concat "^" field ".*\\(, " + (regexp-quote address) "\\)") nil t) + (re-search-forward (concat "^" field ".*\\(" + (regexp-quote address) "\\)") nil t)) + (delete-region (match-beginning 1)(match-end 1))) + (goto-char (point-min)) + (if (and (not nocleanup) + (re-search-forward (concat "^ *" field " *\n") nil t)) + (delete-region (match-beginning 0)(match-end 0))))) + +(defun debian-bug--set-CC (address field) + "Add ADDRESS to FIELD." + (debian-bug--remove-CC address field t) + (save-excursion + (goto-char (point-min)) + (cond + ((re-search-forward (concat "^" field " +$") nil t) ;Empty X-Debbugs-CC: + (insert address)) + ((re-search-forward (concat "^" field "$") nil t) ;Empty X-Debbugs-CC: + (insert " " address)) + ((re-search-forward (concat "^" field ".*$") nil t) ;Existing X-Debbugs-CC + (insert ", " address)) + ((re-search-forward "^Subject:.*\n" nil t) + (insert field " " address "\n")) + ((re-search-forward "^To: .*\n" nil t) + (insert field " " address "\n")) + (t + (insert field " " address "\n"))))) + +(defun debian-bug--toggle-CC (address field) + "Add ADDRESS to FIELD or remove it if present." + (if (debian-bug--is-CC address field) + (debian-bug--remove-CC address field) + (debian-bug--set-CC address field))) + +(defun debian-bug--toggle-CC-myself () + "Toggle X-Debbugs-CC: or Cc: line for myself in the mail header." + (when debian-bug-From-address + (if debian-bug-minor-mode + (debian-bug--toggle-CC debian-bug-From-address "X-Debbugs-CC:") + (debian-bug--toggle-CC debian-bug-From-address "cc:")))) + +(defun debian-bug--toggle-CC-devel () + "Toggle X-Debbugs-CC: or CC: line for debian-devel in the mail header." + (if debian-bug-minor-mode + (debian-bug--toggle-CC "debian-devel@lists.debian.org" "X-Debbugs-CC:") + (debian-bug--toggle-CC "debian-devel@lists.debian.org" "cc:"))) + +(defun debian-bug--is-severity (severity) + "Return t is current report has severity of SEVERITY." + (save-excursion + (goto-char (point-min)) + (if (re-search-forward "^ *Severity: +\\([a-zA-Z]+\\)" nil t) + (let ((actualSeverity (match-string-no-properties 1))) + (string= actualSeverity severity))))) + +(defun debian-bug--set-severity (severity) + "Set bug SEVERITY level." + (interactive (list (completing-read "Severity: " debian-bug-severity-alist + nil t nil nil))) + (if (not severity) + nil ; We're done! + (save-excursion + (goto-char (point-min)) + (cond + ((re-search-forward "^ *Severity: \\([a-zA-Z]+\\)" nil t) + (goto-char (match-beginning 1)) + (delete-region (match-beginning 1)(match-end 1)) + (insert severity)) + ((re-search-forward "^ *Version: .*\n" nil t) + (insert "Severity: " severity)) + ((re-search-forward "^ *Package: .*\n" nil t) + (insert "Severity: " severity)) + (t + (forward-line 6) + (insert "\nSeverity: " severity "\n")))))) + + +(defun debian-bug--is-tags (tag) + "Return t if current report has a tags entry of TAG." + (save-excursion + (goto-char (point-min)) + (re-search-forward (concat "^ *Tags:.*" tag) nil t))) + +(defun debian-bug--remove-tags (tag &optional nocleanup) + "Remove TAG. +Non-nil optional argument NOCLEANUP means remove empty field." + (save-excursion + (goto-char (point-min)) + (if (or (re-search-forward (concat "^ *Tags:.*\\(" tag ", \\)") nil t) + (re-search-forward (concat "^ *Tags:.*\\(, " tag "\\)") nil t) + (re-search-forward (concat "^ *Tags:.*\\(" tag "\\)") nil t)) + (delete-region (match-beginning 1)(match-end 1))) + (goto-char (point-min)) + (if (and (not nocleanup) + (re-search-forward "^ *Tags: *\n" nil t)) + (delete-region (match-beginning 0)(match-end 0))))) + +(defun debian-bug--set-tags (tag) + "Set TAG." + (debian-bug--remove-tags tag t) + (save-excursion + (goto-char (point-min)) + (cond + ((re-search-forward "^ *Tags: *$" nil t) ; Empty "Tags: " + (insert tag)) + ((re-search-forward "^ *Tags:.*$" nil t) ; Existing "Tags: " + (insert ", " tag)) + ((re-search-forward "^ *Severity: .*\n" nil t) + (insert "Tags: " tag "\n")) + ((re-search-forward "^ *Version: .*\n" nil t) + (insert "Tags: " tag "\n")) + ((re-search-forward "^ *Package: .*\n" nil t) + (insert "Tags: " tag "\n")) + (t + (forward-line 6) + (insert "\nTags: " tag "\n"))))) + +(defun debian-bug--toggle-tags (tag) + "Toggle TAG." + (interactive (list (completing-read "Tag: " debian-bug-tags-alist + nil t nil nil))) + (if (not tag) + nil ; We're done! + (if (debian-bug--is-tags tag) + (debian-bug--remove-tags tag) + (debian-bug--set-tags tag)))) + +(defun debian-bug--is-bts-address (address) + "Return t if ADDRESS is present in address field." + (save-excursion + (goto-char (point-min)) + (re-search-forward (concat "^To:.*" (regexp-quote address)) nil t))) + +(defun debian-bug--set-bts-address (address) + "Set \"To\" header field to ADDRESS." + (interactive (list (completing-read "To: " + '(("submit@bugs.debian.org") + ("quiet@bugs.debian.org") + ("maintonly@bugs.debian.org")) + nil t nil nil))) + (cond + ((string= "submit@bugs.debian.org" address) + (setq address debian-bug-mail-address)) + ((string= "quiet@bugs.debian.org" address) + (setq address debian-bug-mail-quiet-address)) + ((string= "maintonly@bugs.debian.org" address) + (setq address debian-bug-mail-maintonly-address))) + (if (not address) + nil ; We're done! + (save-excursion + (goto-char (point-min)) + (cond + ((re-search-forward "^To: \\(.*\\)" nil t) + (goto-char (match-beginning 1)) + (delete-region (match-beginning 1)(match-end 1)) + (insert address)) + (t + (insert "To: " address "\n")))))) + +(defun debian-bug-help-severity () + "Display severity help." + (with-output-to-temp-buffer "*Help*" + (princ "Severity levels + + The bug system records a severity level with each bug report. This is set to + normal by default, but can be overridden either by supplying a Severity line + in the pseudo-header when the bug is submitted (see the instructions for + reporting bugs), or by using the severity command with the control request + server. + + The severity levels are: + + critical + makes unrelated software on the system (or the whole system) break, or + causes serious data loss, or introduces a security hole on systems + where you install the package. + grave + makes the package in question unuseable or mostly so, or causes data + loss, or introduces a security hole allowing access to the accounts of + users who use the package. + serious + is a severe violation of Debian policy (that is, it violates a \"must\" + or \"required\" directive), or, in the package maintainer's opinion, + makes the package unsuitable for release. + important + a bug which has a major effect on the usability of a package, without + rendering it completely unusable to everyone. + normal + the default value, applicable to most bugs. + minor + a problem which doesn't affect the package's usefulness, and is + presumably trivial to fix. + wishlist + for any feature request, and also for any bugs that are very difficult + to fix due to major design considerations. + fixed + for bugs that are fixed but should not yet be closed. This is an + exception for bugs fixed by non-maintainer uploads. Note: the \"fixed\" + tag should be used instead. + +Certain severities are considered release-critical, meaning the bug will +have an impact on releasing the package with the stable release of +Debian. Currently, these are critical, grave and serious. + +Info from http://www.debian.org/Bugs/Developer#severities +Feb 8th 2002, checked Apr 22 2003."))) + +(defun debian-bug-help-tags () + "Display tags help." + (with-output-to-temp-buffer "*Help*" + (princ + "Tags for bug reports + + Each bug can have zero or more of a set of given tags. These tags are + displayed in the list of bugs when you look at a package's page, and when + you look at the full bug log. + + Tags can be set by supplying a Tags line in the pseudo-header when the bug + is submitted (see the instructions for reporting bugs), or by using the + tags command with the control request server. Separate multiple tags with + commas, spaces, or both. + + The current bug tags are: + + patch + A patch or some other easy procedure for fixing the bug is included in + the bug logs. If there's a patch, but it doesn't resolve the bug adequately + or causes some other problems, this tag should not be used. + + wontfix + This bug won't be fixed. Possibly because this is a choice between + two arbitrary ways of doing things and the maintainer and submitter prefer + different ways of doing things, possibly because changing the behaviour + will cause other, worse, problems for others, or possibly for other + reasons. + + moreinfo + This bug can't be addressed until more information is provided by the + submitter. The bug will be closed if the submitter doesn't provide more + information in a reasonable (few months) timeframe. This is for bugs like + \"It doesn't work\". What doesn't work? + + unreproducible + This bug can't be reproduced on the maintainer's system. Assistance + from third parties is needed in diagnosing the cause of the problem. + + help + The maintainer is requesting help with dealing with this bug. + + pending + A solution to this bug has been found and an upload will be made soon. + + fixed + This bug is fixed or worked around (by a non-maintainer upload, for + example), but there's still an issue that needs to be resolved. This tag + replaces the old \"fixed\" severity. + + security + This bug describes a security problem in a package (e.g., bad + permissions allowing access to data that shouldn't be accessible, buffer + overruns allowing people to control a system in ways they shouldn't be + able to, denial of service attacks that should be fixed, etc). Most + security bugs should also be set at critical or grave severity. + + upstream + This bug applies to the upstream part of the package. + + confirmed + The maintainer has looked at, understands, and basically agrees with + the bug, but has yet to fix it. (Use of this tag is optional, it is + intended mostly for maintainers who need to manage large numbers of open + bugs.) fixed-upstream + + The bug has been fixed by the upstream maintainer, but not yet in the + package (for whatever reason: perhaps it is too complicated to backport + the change or too minor to be worth bothering). + + fixed-in-experimental + The bug has been fixed in the package of the experimental + distribution, but not yet in the unstable distribution. + + d-i + This bug is relevant to the development of debian-installer. It is + expected that this will be used when the bug affects installer development + but is not filed against a package that forms a direct part of the + installer itself. + + ipv6 + This bug affects support for Internet Protocol version 6. + + lfs + This bug affects support for large files (over 2 gigabytes). + + l10n + This bug is relevant to the localisation of the package. + + potato + This bug particularly applies to the potato release of Debian. + + woody + This bug particularly applies to the woody distribution. + + sarge + This bug should not be archived until it is fixed in sarge. + + sarge-ignore + This release-critical bug is to be ignored for the purposes of + releasing sarge. This tag should only be used by the release manager, do + not set it yourself without explicit authorization from them. + + etch + This bug should not be archived until it is fixed in etch. + + etch-ignore + This release-critical bug is to be ignored for the purposes of + releasing etch. This tag should only be used by the release manager, do + not set it yourself without explicit authorization from them. + + sid + This bug should not be archived until it is fixed in sid. + + experimental + This bug should not be archived until it is fixed in experimental. + +The meanings of the latter 6 tags have changed recently, the ignore tags +ignore the bug for the purpose of a testing propagation. The release tags, +which used to indicate which bugs affected a specific release now indicate +when a bug can be archived. +Info from http://www.debian.org/Bugs/Developer#tags +Sep 22, 2006"))) + +(defun debian-bug-help-pseudo-packages () + "Display pseudo-packages help." + (with-output-to-temp-buffer "*Help*" + (princ "List of Debian pseudo packages + base — Base system general bugs + bugs.debian.org — The bug tracking system, @bugs.debian.org + buildd.debian.org — Problems and requests related to the Debian Buildds + buildd.emdebian.org — Problems related to building packages for Emdebian + cdimage.debian.org — CD Image issues + cdrom — Installation system + debian-i18n — Requests regarding Internationalization (i18n) of the distribution + debian-maintainers — Problems and requests related to Debian Maintainers + ftp.debian.org — Problems with the FTP site + general — General problems (e.g. \"many manpages are mode 755\") + installation-reports — Reports of installation problems with stable & testing + lists.debian.org — The mailing lists, debian-*@lists.debian.org + mirrors — Problems with the official mirrors + nm.debian.org — New Maintainer process and nm.debian.org webpages + press — Press release issues + project — Problems related to project administration + qa.debian.org — The Quality Assurance group + release-notes — Problems with the Release Notes + release.debian.org — Requests regarding Debian releases and release team tools + security-tracker — The Debian Security Bug Tracker + security.debian.org — The Debian Security Team + snapshot.debian.org — Issues with the snapshot.debian.org service + tech-ctte — The Debian Technical Committee (see the Constitution) + upgrade-reports — Reports of upgrade problems for stable & testing + wiki.debian.org — Problems with the Debian wiki + wnpp — Work-Needing and Prospective Packages list + www.debian.org — Problems with the WWW site + +from http://www.debian.org/Bugs/pseudo-packages, May 13th 2010. +Copyright 1999 Darren O. Benham, 1997, 2003 nCipher Corporation Ltd, +1994-1997 Ian Jackson. +"))) + +(defun debian-bug-help-email () + "Display help about various bug report emails to use." + (with-output-to-temp-buffer "*Help*" + (princ "Info from http://www.debian.org/Bugs/Reporting +Aug 10th 2001 + + If a bug report is minor, for example, a documentation typo or a + trivial build problem, please adjust the severity appropriately and + send it to maintonly@bugs instead of submit@bugs. maintonly will + forward the report to the package maintainer only, it won't forward it + to the BTS mailing lists. + + If you wish to report a bug to the bug tracking system that's already been + sent to the maintainer, you can use quiet@bugs. Bugs sent to quiet@bugs + will not be forwarded anywhere, only filed. + + Bugs sent to maintonly@bugs or to quiet@bugs are *still* posted to + the Debian Bug Tracking System web site (--psg)."))) + + +(easy-menu-define debian-bug-menu debian-bug-minor-mode-map + "Debian Bug Mode Menu" + '("Debian-Bug" + ("Header" + ["Custom From Address" (debian-bug--toggle-custom-From) + :style toggle :active debian-bug-From-address + :selected (debian-bug--is-custom-From)] + "--" + ["To BTS, Maintainer and Mailing Lists" + (debian-bug--set-bts-address + (debian-bug-bts-mail "submit" debian-bug-bts-address)) + :style radio + :selected (debian-bug--is-bts-address + (debian-bug-bts-mail "submit" debian-bug-bts-address))] + ["To BTS and Maintainer Only" + (debian-bug--set-bts-address + (debian-bug-bts-mail "maintonly" debian-bug-bts-address)) + :style radio + :selected (debian-bug--is-bts-address + (debian-bug-bts-mail "maintonly" debian-bug-bts-address))] + ["To BTS Only" + (debian-bug--set-bts-address + (debian-bug-bts-mail "quiet" debian-bug-bts-address)) + :style radio + :selected (debian-bug--is-bts-address + (debian-bug-bts-mail "quiet" debian-bug-bts-address))] + "--" + ["CC debian-devel" (debian-bug--toggle-CC-devel) + :style toggle + :selected (debian-bug--is-CC + "debian-devel@lists.debian.org" "X-Debbugs-CC:")] + ["CC me" (debian-bug--toggle-CC-myself) + :style toggle :active debian-bug-From-address + :selected (debian-bug--is-CC debian-bug-From-address "X-Debbugs-CC:")] + ) + ("Severity" + ["critical" (debian-bug--set-severity "critical") + :style radio :selected (debian-bug--is-severity "critical")] + ["grave" (debian-bug--set-severity "grave") + :style radio :selected (debian-bug--is-severity "grave")] + ["serious" (debian-bug--set-severity "serious") + :style radio :selected (debian-bug--is-severity "serious")] + ["important" (debian-bug--set-severity "important") + :style radio :selected (debian-bug--is-severity "important")] + ["normal" (debian-bug--set-severity "normal") + :style radio :selected (debian-bug--is-severity "normal")] + ["minor" (debian-bug--set-severity "minor") + :style radio :selected (debian-bug--is-severity "minor")] + ["wishlist" (debian-bug--set-severity "wishlist") + :style radio :selected (debian-bug--is-severity "wishlist")] + ) + ("Tags" + ["Patch Included" (debian-bug--toggle-tags "patch") + :style toggle :selected (debian-bug--is-tags "patch")] + ["Security Issue!" (debian-bug--toggle-tags "security") + :style toggle :selected (debian-bug--is-tags "security")] + ) + ("Web View" + ["Bugs for This Package" (debian-bug-web-bugs) t] + ["Archived Bugs for This Package" (debian-bug-web-bugs t) t] + ["Bug Number..." (debian-bug-web-bug) t] + ["Package search for all releases" (debian-bug-web-packages) t] + "-- Package Web Pages --" + ["Stable" (debian-bug-web-package "stable") t] + ["Testing" (debian-bug-web-package "testing") t] + ["Unstable" (debian-bug-web-package "unstable") t] + ) + ["Customize" + (customize-group "debian-bug") (fboundp 'customize-group)] + ("Help" + ["Severities" (debian-bug-help-severity) t] + ["Tags" (debian-bug-help-tags) t] + ["Pseudo-Packages" (debian-bug-help-pseudo-packages) t] + ["Addresses" (debian-bug-help-email) t] + ) + )) + +(defun debian-bug-minor-mode (arg) + "Toggle `debian-bug' mode. +A positive prefix argument ARG turns on `debian-bug' mode\; a negative prefix +argument turn sit off." + (interactive "P") + (set (make-local-variable 'debian-bug-minor-mode) + (if arg + (> (prefix-numeric-value arg) 0) + (not debian-bug-minor-mode))) + (cond + (debian-bug-minor-mode ;Setup the minor-mode + (if (fboundp 'font-lock-add-keywords) + (font-lock-add-keywords nil debian-bug-font-lock-keywords t)) + (debian-bug-bug-menu-init debian-bug-minor-mode-map) + (easy-menu-add debian-bug-menu)))) + +;; Install ourselves: +(or (assq 'debian-bug-minor-mode minor-mode-alist) + (setq minor-mode-alist + (cons '(debian-bug-minor-mode " DBug") minor-mode-alist))) +(or (assq 'debian-bug-minor-mode minor-mode-map-alist) + (setq minor-mode-map-alist + (cons (cons 'debian-bug-minor-mode debian-bug-minor-mode-map) + minor-mode-map-alist))) + +;;; --------- +;;; wnpp-minor-mode - like debian-bug-minor-mode but with limited menu + +(defvar debian-bug-wnpp-minor-mode nil) +(defvar debian-bug-wnpp-minor-mode-map nil + "Keymap for `debian-bug' minor mode.") +(if debian-bug-wnpp-minor-mode-map + nil + (setq debian-bug-wnpp-minor-mode-map (make-sparse-keymap))) + +(easy-menu-define debian-bug-wnpp-menu debian-bug-wnpp-minor-mode-map + "Debian Bug Mode Menu" + '("Debian-Bug" + ["Custom From address" (debian-bug--toggle-custom-From) + :style radio :active debian-bug-From-address + :selected (debian-bug--is-custom-From)] + ["CC to debian-devel header line" (debian-bug--toggle-CC-devel) + :style radio + :selected (debian-bug--is-CC "debian-devel@lists.debian.org" + "X-Debbugs-CC:")] + ["CC to myself header line" (debian-bug--toggle-CC-myself) + :style radio :active debian-bug-From-address + :selected (debian-bug--is-CC debian-bug-From-address "X-Debbugs-CC:")] + ["Customize debian-bug" + (customize-group "debian-bug") (fboundp 'customize-group)] + )) + +(defun debian-bug-wnpp-minor-mode (arg) + "Toggle `debian-bug' mode. +A positive prefix argument ARG turns on `debian-bug' mode\; a negative prefix +argument turn sit off." + (interactive "P") + (set (make-local-variable 'debian-bug-wnpp-minor-mode) + (if arg + (> (prefix-numeric-value arg) 0) + (not debian-bug-wnpp-minor-mode))) + (cond + (debian-bug-wnpp-minor-mode ;Setup the minor-mode + (if (fboundp 'font-lock-add-keywords) + (font-lock-add-keywords nil debian-bug-font-lock-keywords t)) + (easy-menu-add debian-bug-wnpp-menu)))) + +;; Install ourselves: +(or (assq 'debian-bug-wnpp-minor-mode minor-mode-alist) + (setq minor-mode-alist + (cons '(debian-bug-wnpp-minor-mode " WNPPBug") minor-mode-alist))) +(or (assq 'debian-bug-wnpp-minor-mode minor-mode-map-alist) + (setq minor-mode-map-alist + (cons (cons 'debian-bug-wnpp-minor-mode debian-bug-wnpp-minor-mode-map) + minor-mode-map-alist))) + +;;; --------- +;;; browse-url interfaces from debian-changelog-mode.el +;; by Peter Galbraith, Feb 23 2001 + +;;;###autoload +(defun debian-bug-web-bugs (&optional archived) + "Browse the BTS for this package via `browse-url'. +With optional argument prefix ARCHIVED, display archived bugs." + (interactive "P") + (if (not (featurep 'browse-url)) + (progn + (load "browse-url" nil t) + (if (not (featurep 'browse-url)) + (error "This function requires the browse-url elisp package")))) + (let ((pkg-name (or debian-bug-package-name + (and (featurep 'debian-changelog-mode) + (debian-changelog-suggest-package-name)) + (read-string "Package name: ")))) + (if (string-equal "" pkg-name) + (message "No package name to look up") + (if archived + (browse-url + (concat "http://bugs.debian.org/cgi-bin/pkgreport.cgi?src=" + pkg-name "&archive=yes")) + (browse-url (concat "http://bugs.debian.org/cgi-bin/pkgreport.cgi?src=" + pkg-name))) + (message "Looking up bugs for source package %s via browse-url" + pkg-name)))) + +;;;FIXME - This might not be a source package name, and then the page +;;; doesn't exist. +;;;###autoload +(defun debian-bug-web-developer-page () + "Browse the web for this package's developer page." + (interactive) + (if (not (featurep 'browse-url)) + (progn + (load "browse-url" nil t) + (if (not (featurep 'browse-url)) + (error "This function requires the browse-url elisp package")))) + (let ((pkg-name (or debian-bug-package-name + (and (featurep 'debian-changelog-mode) + (debian-changelog-suggest-package-name)) + (read-string "Package name: ")))) + (if (string-equal "" pkg-name) + (message "No package name to look up") + (or (string-match "^lib[a-zA-Z]" pkg-name) + (string-match "^[a-zA-Z]" pkg-name)) + (browse-url (concat "http://packages.qa.debian.org/" + (match-string 0 pkg-name) "/" pkg-name ".html")) + (message "Looking up developer web page for package %s via browse-url" + pkg-name)))) + +(defun debian-bug-prompt-bug-number (prompt) + "Prompt the user for a bug number using PROMPT." + (require 'thingatpt) + (let ((default-number) + (item (word-at-point))) + ;; First see if there's a number under point + (if (and item + (string-match "^[0-9]+[0-9]$" item)) + (setq default-number (match-string-no-properties 0 item)) + ;; If not, try for mail message header + (save-excursion + (goto-char (point-min)) + (if (re-search-forward "\\([0-9]+\\)@bugs.debian.org" + (mail-header-end) t) + (setq default-number (match-string-no-properties 1))))) + (list (completing-read (if default-number + (format "%s [%s]: " prompt default-number) + (format "%s: " prompt)) + debian-bug-alist nil nil nil nil default-number)))) + +;;;###autoload +(defun debian-bug-web-bug (&optional bug-number) + "Browse the BTS for BUG-NUMBER via `browse-url'." + (interactive (debian-bug-prompt-bug-number "Bug number to lookup")) + (if (not (featurep 'browse-url)) + (progn + (load "browse-url" nil t) + (if (not (featurep 'browse-url)) + (error "This function requires the browse-url elisp package")))) + (if (or (not bug-number) (string-equal bug-number "none")) + (setq bug-number (completing-read "Bug number to lookup: " + debian-bug-alist nil nil))) + (if (string-equal bug-number "") + (message "No bug number to look up") + (browse-url (concat debian-bug-bts-URL "archive=yes&bug=" bug-number)) + (message "Looking up bug number %s via browse-url" bug-number))) + +;;;###autoload +(defun emacs-bug-web-bug (&optional bug-number) + "Browse the Emacs BTS for BUG-NUMBER via `browse-url'." + (interactive "NBug number: ") + (let ((debian-bug-bts-URL + "http://debbugs.gnu.org/cgi/bugreport.cgi?")) + (debian-bug-web-bug (number-to-string bug-number)))) + +;;;###autoload +(defun debian-bug-web-this-bug-under-mouse (EVENT) + "Browse the BTS via `browse-url' for the bug report number under mouse. +In a program, mouse location is in EVENT." + (interactive "e") + (mouse-set-point EVENT) + (if (not (looking-at "[0-9]")) + (error "Not a number under point/mouse")) + (save-excursion + (skip-chars-backward "0123456789") + (if (looking-at "[0-9]+") + (let ((bug-number (match-string 0))) + (debian-bug-web-bug bug-number))))) + +;;;###autoload +(defun debian-bug-web-packages () + "Search Debian web page for this package via `browse-url'." + (interactive) + (if (not (featurep 'browse-url)) + (progn + (load "browse-url" nil t) + (if (not (featurep 'browse-url)) + (error "This function requires the browse-url elisp package")))) + (let ((pkg-name (or debian-bug-package-name + (and (featurep 'debian-changelog-mode) + (debian-changelog-suggest-package-name)) + (read-string "Package name: ")))) + (if (string-equal "" pkg-name) + (message "No package name to look up") + (browse-url (concat "http://packages.debian.org/" pkg-name)) +;; 2007-09-02 This URL is becoming obsolete... +;; (concat +;; "http://packages.debian.org/cgi-bin/search_packages.pl?keywords=" +;; pkg-name +;; "&searchon=names&version=all&release=all") + (message "Looking up web pages for package %s via browse-url" pkg-name)))) + +(defvar debian-bug-archive-alist + '(("stable") ("testing") ("unstable")) + "Alist of valid Debian archives for web interface (excludes experimental).") + +(defvar debian-bug-archive-list + '("stable" "testing" "unstable") + "List of valid Debian archives.") + +;;;###autoload +(defun debian-bug-web-package (archive) + "Search Debian web page in ARCHIVE for this package via `browse-url'." + (interactive "P") + (if (not (featurep 'browse-url)) + (progn + (load "browse-url" nil t) + (if (not (featurep 'browse-url)) + (error "This function requires the browse-url elisp package")))) + (let ((pkg-name (or debian-bug-package-name + (and (featurep 'debian-changelog-mode) + (debian-changelog-suggest-package-name)) + (read-string "Package name: ")))) + (if (string-equal "" pkg-name) + (message "No package name to look up") + (if (not (member (list archive) debian-bug-archive-alist)) + (setq archive + (completing-read "Debian archive: " + debian-bug-archive-alist nil t nil))) + (if (string-equal "" archive) + (message "No archive name to look up") + (browse-url (format "http://packages.debian.org/%s/%s" + archive pkg-name)) + (message "Looking up %s web page for package %s via browse-url" + archive pkg-name))))) + +;;;------------- +;;; wget bug from BTS stuff - Peter Galbraith, August 2001 +;;; from debian-changelog-mode.el + +(defun debian-bug-menucount () + "Return the number of bug lines after wget process." + (save-excursion + (goto-char (point-min)) + (- (count-lines (point)(point-max)) 5))) + +(defun debian-bug-menusplit-p (submenu) + "Return t if we should split the menu, comparing bug numbers to frame size. +If SUBMENU is t, then check for current sexp submenu only." + (let* ((menu-count (if submenu + (save-excursion + (count-lines (point) + (progn (forward-sexp 1)(point)))) + (debian-bug-menucount))) + (frame-lines (cond ((< 60 (frame-height)) ;Big frames + (- (frame-height) 17)) + ((< 40 (frame-height)) ;Med frames + (- (frame-height) 10)) + (t + (- (frame-height) 6))))) ;Smaller frames + (if (>= frame-lines menu-count) + nil ; No split at all + t))) + +(defun debian-bug-submenusplit () + "Split this submenu, located in sexp." + (save-excursion + (save-restriction + ;; First, narrow to submenu + (narrow-to-region (point) + (progn (forward-sexp 1)(forward-char -2)(point))) + (goto-char (point-min)) + (forward-line 1) + ;; Now on first bug... + (let ((lines (cond ((< 60 (frame-height)) ;Big frames + (- (frame-height) 25)) + ((< 40 (frame-height)) ;Med frames + (- (frame-height) 20)) + (t + (- (frame-height) 6)))) ;Smaller frames + (start (point)) + (bugn-end)(bugn-beg)) + (while (< (point) (point-max)) + (forward-line lines) + (beginning-of-line) + (looking-at "^\\[\"\\(#?[0-9]+\\):") + (setq bugn-end (match-string 1)) + (end-of-line) + (insert ")") + (goto-char start) + (looking-at "^\\[\"\\(#?[0-9]+\\):") + (setq bugn-beg (match-string 1)) + (insert (format "(\"%s-%s\"\n" bugn-beg bugn-end)) + (forward-line -1) + (forward-sexp 1) + (forward-line 1) + (setq start (point)))))) + (forward-sexp 1) + (beginning-of-line)) + +(defun debian-bug-wget-mbox (&optional bug-number) + "Wget the mbox file for bug BUG-NUMBER and return the filename created." + (if (not debian-bug-download-directory) + (error "Please set ` debian-bug-download-directory'")) + (if (and (not (file-exists-p debian-bug-download-directory)) + (make-directory debian-bug-download-directory) + (not (file-exists-p debian-bug-download-directory))) + (error "Please create directory %s" debian-bug-download-directory)) + (if (not bug-number) + (setq bug-number (completing-read "Bug number to fetch: " + debian-bug-alist nil nil))) + (when bug-number + (let ((filename (expand-file-name + (concat "debian-bug-" + (if debian-bug-package-name + (concat debian-bug-package-name "-")) + bug-number) + debian-bug-download-directory)) + (status) + (url (concat debian-bug-bts-URL "bug=" bug-number + "&mbox=yes&mboxmaint=yes"))) + (if (and (file-exists-p filename) + (not (y-or-n-p "Bug file already exists. Download again? "))) + filename + (message "Downloading bug %s..." bug-number ) + (setq status + (call-process "wget" nil '(t t) nil "--quiet" "-O" filename url)) + (message "Downloading bug %s...done" bug-number) + (if (= 0 status) + filename + (error "`wget' failed")))))) + +;;;###autoload +(defun debian-bug-get-bug-as-file (&optional bug-number) + "Read bug report #BUG-NUMBER as a regular file." + (interactive (debian-bug-prompt-bug-number "Bug number to fetch")) + (let ((filename (debian-bug-wget-mbox bug-number))) + (find-file filename) + (text-mode))) + +;;;###autoload +(defun debian-bug-get-bug-as-email (&optional bug-number) + "Read bug report #BUG-NUMBER via Email interface." + (interactive (progn + ;; a second gnus in a second emacs can clobber .newsrc, ask + ;; the user to start gnus where they want it + (if (and (eq mail-user-agent 'gnus-user-agent) + (not (and (fboundp 'gnus-alive-p) + (gnus-alive-p)))) + (error "Please start `gnus' (or `gnus-slave') first")) + (debian-bug-prompt-bug-number "Bug number to fetch"))) + (run-hooks 'debian-bug-get-bug-as-email-hook) + (cond + ((and (eq mail-user-agent 'mh-e-user-agent) + (featurep 'mh-inc)) + ;; MH-E + (mh-find-path) + (let* ((package-name (cond + (debian-bug-package-name + debian-bug-package-name) + ((featurep 'debian-changelog-mode) + (debian-changelog-suggest-package-name)) + (t + (read-string "Package name: ")))) + (mh-e-folder (concat + (if debian-bug-mh-folder + (concat debian-bug-mh-folder "/") + "+debian-bug-") + (if package-name + (format "%s-" package-name)) + bug-number))) + (if (and (file-exists-p (mh-expand-file-name mh-e-folder)) + (not (y-or-n-p "Bug folder already exists. Download again? "))) + (mh-visit-folder mh-e-folder) + (if (file-exists-p (mh-expand-file-name mh-e-folder)) + (mh-exec-cmd-quiet nil "rmf" mh-e-folder)) + (let ((filename (debian-bug-wget-mbox bug-number))) + (mh-inc-folder filename mh-e-folder) + (delete-file filename))))) + ((eq mail-user-agent 'gnus-user-agent) + (gnus-group-read-ephemeral-group + bug-number `(nndoc "bug" + (nndoc-address ,(debian-bug-wget-mbox bug-number)) + (nndoc-article-type mbox)) + nil + ;; restore current window configuration after quitting the summary + (cons (current-buffer) (current-window-configuration)))) + (t + ;; rmail + (let ((filename (debian-bug-wget-mbox bug-number))) + (rmail filename))))) + +;;;###autoload +(defun emacs-bug-get-bug-as-email (&optional bug-number) + "Read Emacs bug report #BUG-NUMBER via Email interface." + (interactive "NBug number: ") + (let ((debian-bug-package-name "Emacs") + (debian-bug-bts-URL "http://debbugs.gnu.org/cgi/bugreport.cgi?")) + (debian-bug-get-bug-as-email (number-to-string bug-number)))) + +(defvar debian-changelog-menu) + +(defun debian-bug-menu-action (bugnumber) + "Do something with BUGNUMBER based on variable `debian-bug-menu-action'." + (cond + ((equal debian-bug-menu-action 'browse) + (debian-bug-web-bug bugnumber)) + ((equal debian-bug-menu-action 'readfile) + (debian-bug-get-bug-as-file bugnumber)) + ((equal debian-bug-menu-action 'email) + (debian-bug-get-bug-as-email bugnumber)) + ((equal debian-bug-menu-action 'close) + (debian-changelog-close-bug bugnumber)))) + +(defvar debian-changelog-mode-map) + +(load "rfc2047" t t) +(defun debian-bug-rfc2047-decode-string (string) + "Decode the quoted-printable-encoded STRING and return the results. +Only decodes if `rfc2047-decode-string' is available." + (if (fboundp 'rfc2047-decode-string) + (rfc2047-decode-string string) + string)) + +(defvar debian-changelog-close-bug-statement) +(defun debian-bug-build-bug-menu (package &optional source) + "Build a menu listing the bugs for PACKAGE. +Optionally, if SOURCE is t, make it a source package." + (setq debian-bug-alist nil + debian-bug-open-alist nil) + (let ((debian-bug-tmp-buffer + (get-buffer-create "*debian-bug-tmp-buffer*")) + (bug-alist) + (bug-open-alist) + (bugs-are-open-flag t) + (is-changelog-mode + (and (equal major-mode 'debian-changelog-mode) + (boundp 'debian-changelog-close-bug-takes-arg)))) + (save-excursion + (set-buffer debian-bug-tmp-buffer) + (insert "(setq debian-bug-easymenu-list\n'(\"Bugs\"\n") + (insert "[\"* Regenerate list *\" (debian-bug-build-bug-this-menu) t] + \"--\" + [\"Browse\" + (list (setq debian-bug-menu-action 'browse)) + :style radio :selected (equal debian-bug-menu-action 'browse)] + [\"Read as a File\" + (list (setq debian-bug-menu-action 'readfile)) + :style radio :selected (equal debian-bug-menu-action 'readfile)] + [\"Read as Email\" + (list (setq debian-bug-menu-action 'email)) + :style radio :selected (equal debian-bug-menu-action 'email)]\n") + (if is-changelog-mode + (insert " [\"Close Bug\" + (list (setq debian-bug-menu-action 'close)) + :style radio :selected (equal debian-bug-menu-action 'close)]\n")) + (insert " \"-\"\n") + (with-temp-buffer + (message "Fetching bug list...") + (call-process "wget" nil '(t t) nil "--quiet" "-O" "-" + (concat + "http://bugs.debian.org/cgi-bin/pkgreport.cgi?" + (if source "src=" "pkg=") + package)) + (message "Fetching bug list...done") + (goto-char (point-min)) + (while + (re-search-forward +;;; "\\(\\(.+\\)\\)\\|\\(\\(.+: \\(.+\\)\\)\\)" + "\\(\\(.+\\)\\)\\|\\(\\([^#].+\\)\\)" + nil t) + (let ((type (match-string 2)) + ;;(URL (match-string 4)) + (bugnumber (match-string 5)) + (description (match-string 6)) + (shortdescription (match-string 6))) + (cond + ((string= type "-->")) ;Do nothing + (type + (setq bugs-are-open-flag (not (string-match "resolved" type))) + (save-excursion + (set-buffer debian-bug-tmp-buffer) + (insert "\"-\"\n\"" type "\"\n"))) + ((null description)) ;Do nothing + ((string-match "^#?[0-9]+$" description)) ;Do nothing + (t + (if (string-match "^[^ ]+: \\(.+\\)" description) + (setq shortdescription (match-string 1 description))) + (setq bug-alist (cons (list bugnumber description) bug-alist)) + (when bugs-are-open-flag + (when (and (re-search-forward + "Reported by: " + nil t) + (or (looking-at ""\\(.*\\)" <") + (looking-at "\\(.*\\) <") + (looking-at "\\(.*\\)<"))) + (setq shortdescription + (concat "Bug fix: \"" shortdescription + "\", thanks to " + (debian-bug-rfc2047-decode-string + (match-string 1)) + " " (if (fboundp 'replace-regexp-in-string) + (replace-regexp-in-string + "%s" bugnumber + (if (boundp 'debian-changelog-close-bug-statement) + debian-changelog-close-bug-statement + "(Closes: #%s)")) + (debian-bug--rris + "%s" bugnumber + (if (boundp 'debian-changelog-close-bug-statement) + debian-changelog-close-bug-statement + "(Closes: #%s)")))))) + (setq bug-open-alist + (cons + (list bugnumber shortdescription) bug-open-alist))) + (save-excursion + (set-buffer debian-bug-tmp-buffer) + (insert + "[" + (format "%S" (concat "#" bugnumber " " + (if (< 60 (length description)) + (substring description 0 60) + description))) + " (debian-bug-menu-action \"" bugnumber "\")" + " :active " + (if bugs-are-open-flag + "t" + "(not (eq debian-bug-menu-action 'close))") + "]\n"))))))) + (set-buffer debian-bug-tmp-buffer) ;Make sure we're here + (insert "))") + (when (debian-bug-menusplit-p nil) + (goto-char (point-min)) + ;; First split on bug severities + (when (and (re-search-forward "^\"-" nil t) + (re-search-forward "^\"" nil t)) + (when (search-forward " to upstream software authors" + (save-excursion (progn (end-of-line)(point))) + t) + (replace-match " upstream")) + (beginning-of-line) + (insert "(") + (while (and (re-search-forward "^\"-" nil t) + (re-search-forward "^\"" nil t)) + (when (search-forward " to upstream software authors" + (save-excursion (progn (end-of-line)(point))) + t) + (replace-match " upstream")) + (beginning-of-line) + (insert ")(")) + (goto-char (point-max)) + (insert ")") + ;; Next check for long menus, and split those again + (goto-char (point-min)) + (while (re-search-forward "^)?(\"" nil t) + (forward-char -2) + (if (debian-bug-menusplit-p t) + (debian-bug-submenusplit) + (end-of-line))) + )) + (eval-buffer debian-bug-tmp-buffer) + (kill-buffer nil) + ) + (setq debian-bug-alist bug-alist) + (setq debian-bug-open-alist bug-open-alist) + (cond + ((equal major-mode 'debian-changelog-mode) + (easy-menu-define + debian-bug-bugs-menu + debian-changelog-mode-map "Debian Bug Mode Bugs Menu" + debian-bug-easymenu-list) + (cond + ((string-match "XEmacs" emacs-version) + (easy-menu-remove debian-bug-bugs-menu) + (easy-menu-remove debian-changelog-menu) + (easy-menu-add debian-bug-bugs-menu) + (easy-menu-add debian-changelog-menu)))) + (t + (easy-menu-define + debian-bug-bugs-menu + debian-bug-minor-mode-map "Debian Bug Mode Bugs Menu" + debian-bug-easymenu-list) + (cond + ((string-match "XEmacs" emacs-version) + (easy-menu-remove debian-bug-bugs-menu) + (easy-menu-remove debian-bug-menu) + (easy-menu-add debian-bug-bugs-menu) + (easy-menu-add debian-bug-menu))))))) + +(defun debian-bug-build-bug-this-menu () + "Regenerate Bugs list menu for this buffer's package." + (if (and (featurep 'debian-changelog-mode) + (debian-changelog-suggest-package-name)) + (debian-bug-build-bug-menu (debian-changelog-suggest-package-name) t) + (let ((package (or (and (boundp 'debian-bug-package-name) + debian-bug-package-name) + (read-string "Package name: ")))) + (debian-bug-build-bug-menu package nil)))) + +(defun debian-bug-bug-menu-init (minor-mode-map) + "Initialize empty bug menu. +Call this function from the mode setup with MINOR-MODE-MAP." + (if debian-bug-menu-preload-flag + (debian-bug-build-bug-this-menu) + (easy-menu-define debian-bug-bugs-menu minor-mode-map + "Debian Bug Mode Bugs Menu" + '("Bugs" + ["* Generate menu *" (debian-bug-build-bug-this-menu) + (debian-bug-check-for-program "wget")]))) + (easy-menu-add debian-bug-bugs-menu)) + +;;;------------- +;;; debian-bug-filename - Peter Galbraith, July 2002. +;;; + +(defun debian-bug-search-file (filename) + "Search for FILENAME returning which package name it belongs to." + (save-excursion + (let ((tmp-buffer (get-buffer-create " *debian-bug-tmp*")) + (expanded-file (expand-file-name filename)) + (package)) + (set-buffer tmp-buffer) + (unwind-protect + (progn + (condition-case err + (call-process "dlocate" nil '(t nil) nil "-S" expanded-file) + (file-error + (message "dlocate not installed..."))) + (goto-char (point-min)) + (when (re-search-forward + (concat "^\\(.*\\): " (regexp-quote expanded-file) "$") + nil t) + ;; found one at least. Try for another. + (setq package (match-string 1)) + (when (re-search-forward + (concat "^.*: " (regexp-quote expanded-file) "$") nil t) + (setq package nil))) + (if package + package + (message "Calling dpkg for the search...") + (erase-buffer) + (call-process "dpkg" nil '(t nil) nil "-S" + (expand-file-name filename)) + (message "Calling dpkg for the search...done") + (goto-char (point-min)) + (cond + ((re-search-forward "not found.$" nil t) + (message "%s not found in package list" filename) + nil) + ((re-search-forward "^\\(.*, .*\\): " nil t) + (with-output-to-temp-buffer "*Help*" + (princ (format "Please refine your search,\nthere is more than one matched package:\n\n%s" (match-string 1)))) + nil) + ((re-search-forward "^\\(.*\\): " nil t) + (match-string 1)) + (t + (message "%s not found in package list" filename) + nil)))) + (kill-buffer tmp-buffer))))) + +(defun debian-bug-filename () + "Submit a Debian bug report for a given filename's package." + (let ((filename (read-file-name "Filename: " "/" nil t nil))) + (cond + ((string-equal "" filename) + (message "Giving up")) + (t + (let ((package (debian-bug-search-file filename))) + (if package + (let ((answer (y-or-n-p (format "File is in package %s; continue? " + package)))) + (when answer + (debian-bug-package package filename))))))))) + +;;;###autoload +(defun debian-bug () + "Submit a Debian bug report." + (interactive) + (let ((type (let ((cursor-in-echo-area t)) + (message + "Report a bug for a [P]ackage or [F]ile: (default P) ") + (capitalize (read-char-exclusive))))) + (cond + ((or (equal 13 type) ; + (equal ?\r type) ; + (equal ?\ type) ; + (equal 32 type) ; + (equal ?p type) + (equal ?P type)) + (debian-bug-package)) + ((equal ?F type) + (debian-bug-filename)) + (t + (message "Sorry, try that again"))))) + +(provide 'debian-bug) + +;;; debian-bug.el ends here diff --git a/elisp/debian-el/debian-el-loaddefs.el b/elisp/debian-el/debian-el-loaddefs.el new file mode 100755 index 0000000..3df68ee --- /dev/null +++ b/elisp/debian-el/debian-el-loaddefs.el @@ -0,0 +1,175 @@ +;;; debian-el-loaddefs.el --- automatically extracted autoloads +;; +;;; Code: + +(provide 'debian-el-loaddefs) + +;;;### (autoloads (apt-sources-mode) "apt-sources" "apt-sources.el" +;;;;;; (19215 18611)) +;;; Generated autoloads from apt-sources.el + +(autoload 'apt-sources-mode "apt-sources" "\ +Major mode for editing apt's sources.list file. +Sets up command `font-lock-mode'. + +\\{apt-sources-mode-map} + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads (apt-utils-search apt-utils-show-package) "apt-utils" +;;;;;; "apt-utils.el" (18850 53763)) +;;; Generated autoloads from apt-utils.el + +(autoload 'apt-utils-show-package "apt-utils" "\ +Show information for a Debian package. +A selection of known packages is presented. See `apt-utils-mode' +for more detailed help. If NEW-SESSION is non-nil, generate a +new `apt-utils-mode' buffer. + +\(fn &optional NEW-SESSION)" t nil) + +(autoload 'apt-utils-search "apt-utils" "\ +Search Debian packages for regular expression. +To search for multiple patterns use a string like \"foo && bar\". +The regular expression used to split the +terms (`apt-utils-search-split-regexp') is customisable. + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads (deb-find deb-view-mode deb-view deb-view-dired-view) +;;;;;; "deb-view" "deb-view.el" (19183 30392)) +;;; Generated autoloads from deb-view.el + +(autoload 'deb-view-dired-view "deb-view" "\ +View Debian package control and data files. +Press \"q\" in either window to kill both buffers +and return to the dired buffer. See deb-view. + +\(fn)" t nil) + +(autoload 'deb-view "deb-view" "\ +View Debian package DEBFILE's control and data files. +Press \"q\" in either window to kill both buffers. + +In dired, press ^d on the dired line of the .deb file to view. +Or, execute: ESCAPE x deb-view RETURN, and enter the .deb file name +at the prompt. + +\(fn DEBFILE)" t nil) + +(autoload 'deb-view-mode "deb-view" "\ +View mode for Debian Archive Files. + +\(fn)" t nil) + +(autoload 'deb-find "deb-view" "\ +Search for deb files. +Use the method specified by the variable deb-find-method, and collect +output in a buffer. See also the variable deb-find-directory. + +This command uses a special history list, so you can +easily repeat a `deb-find' command. + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads (debian-bug emacs-bug-get-bug-as-email debian-bug-get-bug-as-email +;;;;;; debian-bug-get-bug-as-file debian-bug-web-package debian-bug-web-packages +;;;;;; debian-bug-web-this-bug-under-mouse emacs-bug-web-bug debian-bug-web-bug +;;;;;; debian-bug-web-developer-page debian-bug-web-bugs debian-bug-intent-to-package +;;;;;; debian-bug-request-for-package debian-bug-wnpp) "debian-bug" +;;;;;; "debian-bug.el" (19428 39961)) +;;; Generated autoloads from debian-bug.el + +(autoload 'debian-bug-wnpp "debian-bug" "\ +Submit a WNPP bug report to Debian. +Optional argument ACTION can be provided in programs. + +\(fn &optional ACTION)" t nil) + +(autoload 'debian-bug-request-for-package "debian-bug" "\ +Shortcut for `debian-bug-wnpp' with RFP action. + +\(fn)" t nil) + +(autoload 'debian-bug-intent-to-package "debian-bug" "\ +Shortcut for `debian-bug-wnpp' with ITP action (for Debian developers). + +\(fn)" t nil) + +(autoload 'debian-bug-web-bugs "debian-bug" "\ +Browse the BTS for this package via `browse-url'. +With optional argument prefix ARCHIVED, display archived bugs. + +\(fn &optional ARCHIVED)" t nil) + +(autoload 'debian-bug-web-developer-page "debian-bug" "\ +Browse the web for this package's developer page. + +\(fn)" t nil) + +(autoload 'debian-bug-web-bug "debian-bug" "\ +Browse the BTS for BUG-NUMBER via `browse-url'. + +\(fn &optional BUG-NUMBER)" t nil) + +(autoload 'emacs-bug-web-bug "debian-bug" "\ +Browse the Emacs BTS for BUG-NUMBER via `browse-url'. + +\(fn &optional BUG-NUMBER)" t nil) + +(autoload 'debian-bug-web-this-bug-under-mouse "debian-bug" "\ +Browse the BTS via `browse-url' for the bug report number under mouse. +In a program, mouse location is in EVENT. + +\(fn EVENT)" t nil) + +(autoload 'debian-bug-web-packages "debian-bug" "\ +Search Debian web page for this package via `browse-url'. + +\(fn)" t nil) + +(autoload 'debian-bug-web-package "debian-bug" "\ +Search Debian web page in ARCHIVE for this package via `browse-url'. + +\(fn ARCHIVE)" t nil) + +(autoload 'debian-bug-get-bug-as-file "debian-bug" "\ +Read bug report #BUG-NUMBER as a regular file. + +\(fn &optional BUG-NUMBER)" t nil) + +(autoload 'debian-bug-get-bug-as-email "debian-bug" "\ +Read bug report #BUG-NUMBER via Email interface. + +\(fn &optional BUG-NUMBER)" t nil) + +(autoload 'emacs-bug-get-bug-as-email "debian-bug" "\ +Read Emacs bug report #BUG-NUMBER via Email interface. + +\(fn &optional BUG-NUMBER)" t nil) + +(autoload 'debian-bug "debian-bug" "\ +Submit a Debian bug report. + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads nil nil ("debian-el.el" "gnus-BTS.el") (19428 40248 +;;;;;; 570272)) + +;;;*** + +;;;### (autoloads (preseed-mode) "preseed" "preseed.el" (17245 35005)) +;;; Generated autoloads from preseed.el + +(autoload (quote preseed-mode) "preseed" "\ +Major mode for editing debian-installer preseed files colourfully." t nil) + +;;;*** diff --git a/elisp/debian-el/debian-el-loaddefs.make b/elisp/debian-el/debian-el-loaddefs.make new file mode 100755 index 0000000..0957567 --- /dev/null +++ b/elisp/debian-el/debian-el-loaddefs.make @@ -0,0 +1 @@ + emacs -batch --no-site-file --multibyte --eval '(setq load-path (cons "." load-path))' -l autoload --eval '(setq generated-autoload-file (expand-file-name "debian-el-loaddefs.el"))' --eval '(setq make-backup-files nil)' -f batch-update-autoloads . diff --git a/elisp/debian-el/debian-el.el b/elisp/debian-el/debian-el.el new file mode 100755 index 0000000..26424ca --- /dev/null +++ b/elisp/debian-el/debian-el.el @@ -0,0 +1,104 @@ +;;; debian-el.el --- startup file for the debian-el package + +;;; Commentary: +;; +;; This file is loaded from /etc/emacs/site-start.d/50debian-el.el + +;;; History: +;; +;; 2008-04-12 - Géraud Meyer +;; - Use apt-sources-mode for files in /etc/apt/sources.list.d/ too. +;; - Use \' instead of $ for the end of filenames. +;; 2003-09-01 - Peter Galbraith +;; - Created. + +;;; Code: + +(defgroup debian-el nil + "Debian debian-el package customization." + :group 'convenience) + +(require 'debian-el-loaddefs) +;;(require 'debian-el-custom) + +;; apt-sources +(add-to-list 'auto-mode-alist '("sources\\.list\\'" . apt-sources-mode)) +(add-to-list 'auto-mode-alist '("sources\\.list\\.d/.*\\.list\\'" . apt-sources-mode)) +(defgroup apt-sources nil "Mode for editing apt sources.list files" + :group 'tools + :prefix "apt-sources-" + :link '(custom-manual "(debian-el)apt-sources") + :load 'apt-sources +;;:require 'apt-sources + :group 'debian-el) + +;; apt-utils +(defgroup apt-utils nil + "Emacs interface to APT (Debian package management)" + :group 'tools + :link '(url-link "http://www.tc.bham.ac.uk/~matt/AptUtilsEl.html") + :link '(custom-manual "(debian-el)apt-utils") + :load 'apt-utils +;;:require 'apt-utils + :group 'debian-el) + +;; debian-bug.el +(defgroup debian-bug nil "Debian Bug report helper" + :group 'tools + :prefix "debian-bug-" + :link '(custom-manual "(debian-el)debian-bug") + :load 'debian-bug +;;:require 'debian-bug + :group 'debian-el) + +;; deb-view.el +(setq auto-mode-alist + (append '(("\\.u?deb\\'" . deb-view-mode)) auto-mode-alist)) +(defgroup deb-view nil + "View Debian package files with tar-mode" + :group 'tools + :prefix "deb-view" + :link '(custom-manual "(debian-el)deb-view") + :load 'deb-view + :group 'debian-el) +(add-hook + 'dired-load-hook + (function (lambda () + (define-key dired-mode-map "\C-d" 'deb-view-dired-view)))) + +(when (member 'utf-8 (coding-system-list)) + ;; The following from Kevin Ryde + ;; Closes: #484027 + (defun deb-view-control-coding (arg-list) + "Return coding system for the \"control\" file in a deb. +This function is for use from `file-coding-system-alist'. + +ARG-LIST is arguments passed to `find-operation-coding-system'. +The only operation handled here is `insert-file-contents' with a +buffer filename \".deb-INFO!./control\", for which the return is +'utf-8, and for anything else the return is nil (letting +`find-operation-coding-system' try other things). + +This is done as a function because the filename passed to +find-operation-coding-system by tar-mode is merely the archive +member \"./control\". By looking at the buffer-file-name we can +tell if it's from a deb. + +Note: This only works in emacs22, in emacs21 or xemacs21 tar-mode +does something a bit different and doesn't reach here (and +there's no buffer passed to coding system functions)." + (if (and (eq (car arg-list) 'insert-file-contents) ;; first arg + (consp (cadr arg-list)) ;; second arg like ("./control" . BUFFER) + (let ((buffer (cdr (cadr arg-list)))) + (and (buffer-file-name buffer) + (string-match "\\.deb-INFO!\\./control\\'" + (buffer-file-name buffer)) + 'utf-8))) + 'undecided)) + + (add-to-list 'file-coding-system-alist + '("\\'control\\'" . deb-view-control-coding))) + +(provide 'debian-el) + +;;; debian-el.el ends here diff --git a/elisp/debian-el/debian-el.texi b/elisp/debian-el/debian-el.texi new file mode 100755 index 0000000..37b53c6 --- /dev/null +++ b/elisp/debian-el/debian-el.texi @@ -0,0 +1,331 @@ +@c -*- mode: texinfo -*- +\input texinfo + +@c $Id: debian-el.texi,v 1.7 2008-04-12 13:10:57 psg Exp $ +@c %**start of header +@setfilename info/debian-el +@settitle debian-el +@c %**end of header + +@dircategory Emacs +@direntry +* Debian-el: (debian-el). Debian-specific tools for Emacs +@end direntry + +@c Version variables. +@set EDITION 1.1 +@set UPDATED 24 October 2005 + +@ifinfo +This is Edition @value{EDITION}, last updated @value{UPDATED}, of +@cite{debian-el}. +@end ifinfo + +@titlepage +@title debian-el: Debian-specific tools for Emacs +@subtitle A manual for what's in this package. +@author Peter S. Galbraith +@end titlepage + +@node Top, apt-sources, (dir), (dir) +@top The debian-el Package Setup + +This manual describes the debian-el package and its +setup. A quick descriptions of elisp files contained in this package +can be found in the file +@file{/usr/share/doc/debian-el/README.Debian}. + +All packaged files are installed, setup and ready to use (they don't +override standard Emacs commands, modes, or settings). + +To customize setup of all customizable packages on a finer-grain +basis, do: +@example +@kbd{M-x} customize-group @key{RET} debian-el @key{RET} +@end example + +@menu +* apt-sources:: Mode for editing apt sources.list files +* apt-utils:: Emacs interface to APT +* debian-bug:: Report a bug to Debian's bug tracking system +* deb-view:: View Debian package archive files with tar-mode +* gnus-BTS:: Access the Debian Bug Tracking System from Gnus +* pressed:: Mode for debian-installer preseed files +@detailmenu + --- The Detailed Node Listing --- + +deb-view - View Debian package archive files with tar-mode + +* deb-view configuration:: +* deb-view usage:: + +@end detailmenu +@end menu + +This work compiles GPL'ed documentation from the files in +/usr/share/emacs/site-lisp/debian-el/. As a derived work from GPL'ed +works, this text is also licensed under the GPL V2 (See +/usr/share/common-licenses/GPL-2) and is edited by Peter S. Galbraith +@email{psg@@debian.org}. + +@node apt-sources, apt-utils, Top, Top +@chapter apt-sources - Mode for editing apt sources.list files. + +This mode is for editing @file{/etc/apt/sources.list} and +@file{/etc/apt/sources.list.d/*.list}, the APT (Advanced Package Tool) +configuration files found on Debian systems. + +APT is a package retrieval tool for Debian; for example you could +install Emacs with the command: + +@example + apt-get install emacs21 +@end example + +and APT will then retrieve the package and install it for you. The +sources.list file tells APT where to look for packages. Mine looks +like this: + +@example + deb http://http.us.debian.org/debian unstable main contrib + deb http://non-us.debian.org/debian-non-US unstable/non-US main + + deb ftp://ftp.de.debian.org/debian ../project/experimental main +@end example + +This mode font-locks the file and add some things including new +source lines and modifying existing source lines. + +This mode can be customized in diferent parts. You can (interactively) +change if you want blank lines around a new source line and comment +with @code{apt-sources-around-lines}. Also you can change the way that +this mode names each source line with the variable +@code{apt-sources-source-name}; if no name is entered, no comment name +will be inserted. + +You can modify existing parts of the source line; check the mode +documentation for more details. Another thing that this mode can do is +to replicate an existing line (@kbd{C-c C-r}) that will be changed to +the 'deb' or 'deb-src' corresponding line. If it replicates a 'deb' +line, an identical 'deb-src' source line will be created. + +@node apt-utils, debian-bug, apt-sources, Top +@chapter apt-utils - Emacs interface to APT + +Start things off using e.g.: +@example +@kbd{M-x} apt-utils-show-package @key{RET} emacs21 @key{RET} +@end example + +Other packages (dependencies, conflicts etc) can be navigated using +@command{apt-utils-next-package} (@key{TAB}), +@command{apt-utils-prev-package} (@key{M-TAB}), +@command{apt-utils-choose-package-link} (@key{>}) or +@command{apt-utils-follow-link} (@key{RET}). Return to the previous +package with @command{apt-utils-view-previous-package} (@key{<}). + +ChangeLog and README files for the current package can easily be +accessed with, for example, @command{apt-utils-view-changelog} (@key{C}). + +For normal (i.e., not virtual) packages, the information can be toggled +between `package' and `showpkg' displays using +@command{apt-utils-toggle-package-info} (@key{t}); the latter is useful +for the "Reverse Depends". + +View the key bindings with describe-mode (bound to ? by default) +or use the menu. + +You may alter various settings of @code{apt-utils} bu customizing the +group @code{apt-utils}. + +@node debian-bug, deb-view, apt-utils, Top +@chapter debian-bug - report a bug to Debian's bug tracking system + +@noindent Useful commands provided by this package: + +@table @samp +@item debian-bug +Submit a Debian bug report against a package or file. + +@item debian-bug-wnpp +Submit a WNPP bug report to Debian. + +@item debian-bug-request-for-package +Shortcut for @code{debian-bug-wnpp} with RFP action. + +@item debian-bug-intent-to-package +Shortcut for @code{debian-bug-wnpp} with ITP action (for Debian developers). + +@item debian-bug-web-bugs +Browse the BTS for this package via @code{browse-url}." + +@item debian-bug-web-bug +Browse the BTS for BUG-NUMBER via @code{browse-url} + +@item debian-bug-web-this-bug +Browse the BTS via @code{browse-url} for the bug report number under point. + +@item debian-bug-web-this-bug-under-mouse +Browse the BTS via @code{browse-url} for the bug report number under mouse. +(Normally bound to mouse-2 in some modes) + +@item debian-bug-web-packages +Search Debian web page for this package via @code{browse-url}. + +@item debian-bug-web-package +Search Debian web page in ARCHIVE for this package via @code{browse-url}. + +@item debian-bug-get-bug-as-file +Read bug report #BUG-NUMBER as a regular file. + +@item debian-bug-get-bug-as-email +Read bug report #BUG-NUMBER via Email interface. + +@end table + +@noindent The command @command{M-x debian-bug} prompts for required +information to start filling in the mail draft buffer. It then allows +you to edit these fields in the mail draft buffer with a useful +menu-bar and view help text about your various options. If the Debian +package @code{wget} is installed, you may download the list of bugs +for the affected package at that time, and download the text of a +specific bug number as well. + +@noindent The debian-bug facility depends on the reportbug package. + +@node deb-view, gnus-BTS, debian-bug, Top +@chapter deb-view - View Debian package archive files with tar-mode + +@noindent Author: Rick Macdonald (rickm@@vsl.com) + +deb-view presents the contents of debian package archive files for +viewing. The viewing is done with the major mode "debview", which +is derived from emacs tar-mode with a few enhancements for viewing +compressed files, HTML files and formatted man pages. The normal +editing and saving features of tar-mode are not supported by +deb-view. + +deb-view includes a command called @command{deb-find} which requires that you +have the debian distribution directories on a local or mounted +filesystem. Give it a string or regular expression and it presents a +buffer of matching deb file names. Click with the middle mouse button +or press @key{RETURN} (or @key{C-c C-c}) and it launches deb-view on the selected +file. deb-find can be configured to use locate or find, or any other +external command. The find method passes your search specification to +egrep, whereas the locate method uses your string directly. + +deb-view extracts the control.tar.gz and data.tar.gz files from +debian package and presents two buffers in a derivitive of +tar-mode. See tar-mode for info. + +@noindent Optionally required programs: +@table @samp +@item nroff +for formatting man pages. +@item dpkg-deb +for old-style binary .deb files. +@item w3-mode +for viewing HTML pages. +@end table + +For new-style .deb files (2.0), dpkg-deb isn't used. + +@menu +* deb-view configuration:: +* deb-view usage:: +@end menu + +@node deb-view configuration, deb-view usage, deb-view, deb-view +@section Configuration + +deb-view is mostly unobtrusive, but does bind @key{C-d} in dired to +@command{deb-view-dired-view}. The "debview" mode is derived from +tar-mode.el using derived.el. Compared to tar-mode, debview-mode +binds @key{q}, @key{N}, @key{W}, and re-binds @key{v}. Also, the normal editing and saving +features of tar-mode are not supported by debview mode and those +keys are disabled. + +@command{deb-find} has two variables to set. @code{deb-find-method} can be "locate" or +"find". Any other value will be assumed to be an external script or +program that you supply. If you set @code{deb-find-method} to "find" then you +must also set @code{deb-find-directory} to the directory containing the +debian distribution. The find command starts at this point. I originally +used the locate option, but contrary to the man page it doesn't seem to +understand even simple regular expressions. I prefer the find option. It +uses egrep and therefore understands complex regular expressions. +You might want to bind @command{deb-find} to a special key. I use @key{C-d} like this: + +@verbatim + (define-key ctl-x-map "\C-d" 'deb-find) +@end verbatim + +Note that this key is normally the brief @command{list-directory} command, a +command that I never used anyway. + + +@node deb-view usage, , deb-view configuration, deb-view +@section Usage + +In dired, press @key{f} or @key{e} on the dired line of the .deb file to view. +You can also use @key{C-d}, which is actually slightly faster since the +deb file isn't loaded into a buffer needlessly. + +Or, execute: @command{M-x deb-view RETURN}, and enter the .deb file name +at the prompt. + +Or, execute: @command{M-x deb-find RETURN}, and enter any substring of a +deb file name to search for. A buffer of matches is created. +Launch @command{deb-view} by selecting a deb file with the middle mouse button, +or @key{RETURN} or @key{C-c}. Exit this buffer with @key{q}. + +You are shown two tar files in debview-mode (see tar-mode for help). +In the case of old .deb format files, the control info is shown +but not the other files of control.tar, such as install scripts. +Note that regular tar-mode commands @key{e}, @key{f} and @key{RETURN} show raw files +without any special uncompressing or formatting. +Additional features that deb-view adds to tar-mode: + +@table @samp +@item q +kill both view buffers (INFO and DATA) and return to the +dired buffer if that's where you executed deb-mode. +@item v +executes deb-view-tar-view instead of tar-view, with the +additional smarts to uncompress .gz and .Z files for viewing. +@item N +Like in dired, formats man pages for viewing, with the +additional smarts to uncompress .gz and .Z man files for viewing. +@item W +use w3-mode to view an HTML file. +@end table + +To view files not supported by deb-view, such as graphics, use the +copy command (@key{c}) to copy the file to a temp directory. You can +then do what you want to the file. + +@node gnus-BTS, pressed, deb-view, Top +@chapter gnus-BTS - access the Debian Bug Tracking System from Gnus + +Use this if you read a lot of debian lists in GNUS and see references +to the Bug Tracking system in them. It expects to see Bug references +in the form of (for example): "#48273", "closes: 238742" or similar +and will make them clickable. + +To enable this, add the following to your @file{~/.emacs} file: + +@example +(require 'gnus-BTS) +@end example + +@node pressed, , gnus-BTS, Top +@chapter preseed - major mode for debian-installer preseed files + +@noindent Author: W. Borgert + +A simple major-mode for editing debian-installer preseed files. Since +such files don't always have the same extension, this mode is not +autoloaded. Enter it by using teh command line: + +@example +M-x preseed-mode +@end example diff --git a/elisp/debian-el/gnus-BTS.el b/elisp/debian-el/gnus-BTS.el new file mode 100755 index 0000000..2785edd --- /dev/null +++ b/elisp/debian-el/gnus-BTS.el @@ -0,0 +1,124 @@ +;;; gnus-BTS.el --- access the Debian Bug Tracking System from Gnus + +;; Copyright (C) 2001 Andreas Fuchs + +;; Author: Andreas Fuchs +;; Maintainer: Andreas Fuchs +;; Keywords: gnus, Debian, Bug +;; Status: Works in XEmacs (I think >=21) +;; Created: 2001-02-07 + +;; $Id: gnus-BTS.el,v 1.2 2013/12/04 22:32:10 psg Exp $ + +;; This file is not part of GNU Emacs. + +;; gnus-BTS.el 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. + +;; gnus-BTS.el 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 this program if you read a lot of debian lists and see many +;; references to the Bug Tracking system in them. It expects to see +;; Bug references in the form of (for example): "#48273", "closes: +;; 238742" or similar. + +;;; Code: + + +(setq anti-bug-special-keywords "reassign\\|merge") +(setq anti-bug-keywords (concat + "tags\\|severity\\|retitle\\|close\\|closes:\\|Merged\\|reopen\\|Bug\\|" + anti-bug-special-keywords)) + +(setq anti-bug-prefix " *#?\\|Bugs?\\|#") +(setq anti-bug-number " *\\([0-9]+\\)") +(setq anti-bug-special " +\\([0-9]+\\|[-.A-Za-z0-9]+\\)") + +(setq anti-gnus-debian-bug-regexp (concat + "\\(" + "\\(" + anti-bug-keywords + "\\)" + anti-bug-prefix + "\\)" + anti-bug-number)) + +(setq anti-gnus-debian-reassign-or-merge-regexp + (concat + "\\(" + anti-bug-special-keywords + "\\)" + anti-bug-number + anti-bug-special)) + +(setq anti-gnus-debian-reassign-regexp "reassigned from package `\\([^']*\\)' to `\\([^']*\\)'") +(setq anti-gnus-debian-bug-BTS-regexp "^ *\\([0-9]+\\)") + +(defun anti-browse-debpkg-or-bug (thing) + (interactive "i") + (require 'thingatpt) + (let* ((the-thing (if (null thing) + (thing-at-point 'sexp) + thing)) + (bugp (string-match "[0-9]+$" the-thing)) + (bug-or-feature (if bugp + (progn + (string-match "^[^0-9]*\\([0-9]+\\)$" the-thing) + (match-string 1 the-thing)) + the-thing)) + (url (if bugp + "http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=" + "http://cgi.debian.org/cgi-bin/search_packages.pl?&searchon=names&version=all&release=all&keywords="))) + (browse-url (concat url bug-or-feature)))) + +(defvar in-debian-group-p nil) +(add-hook 'gnus-select-article-hook + (lambda () + (setq in-debian-group-p (string-match "debian" + (gnus-group-real-name + gnus-newsgroup-name))))) + +(defvar in-debian-devel-announce-group-p nil) +(add-hook 'gnus-select-article-hook + (lambda () + (setq in-debian-devel-announce-group-p + (string-match "debian.devel.announce" + (gnus-group-real-name + gnus-newsgroup-name))))) + +(defun anti-buttonize-debian (regexp num predicate) + (add-to-list 'gnus-button-alist + (list regexp + num + predicate + 'anti-browse-debpkg-or-bug + num))) + +(add-hook + 'gnus-article-mode-hook ; only run once, as soon as the article buffer has been created. + (lambda () + (anti-buttonize-debian anti-gnus-debian-bug-regexp 3 + 'in-debian-group-p) + (anti-buttonize-debian anti-gnus-debian-reassign-or-merge-regexp 3 + 'in-debian-group-p) + (anti-buttonize-debian anti-gnus-debian-bug-BTS-regexp 1 + 'in-debian-devel-announce-group-p) + + (anti-buttonize-debian anti-gnus-debian-reassign-regexp 1 + 'in-debian-group-p) + (anti-buttonize-debian anti-gnus-debian-reassign-regexp 2 + 'in-debian-group-p))) + +(provide 'gnus-BTS) diff --git a/elisp/debian-el/preseed.el b/elisp/debian-el/preseed.el new file mode 100755 index 0000000..d555129 --- /dev/null +++ b/elisp/debian-el/preseed.el @@ -0,0 +1,48 @@ +;;; preseed.el --- a major mode for editing debian-installer preseed files + +;; Copyright (C) 2004 W. Borgert + +;; This package 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 package 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. + +;;; Code: +(require 'font-lock) + +(defvar preseed-mode-abbrev-table nil + "Abbreviation table used in d-i preseed buffers.") +(define-abbrev-table 'preseed-mode-abbrev-table ()) + +(defvar preseed-font-lock-keywords + '(("^\\([a-z-]+\\)[ \t]+\\([^ ]+\\)[ \t]+\\([^ ]+\\)" + (1 font-lock-keyword-face) + (2 font-lock-function-name-face) + (3 font-lock-type-face)) + ("\\(^\\s-*#.*\\)" + (1 font-lock-comment-face))) + "Keyword patterns for preseed-mode fontification.") + +;;;###autoload +(defun preseed-mode () + "Major mode for editing debian-installer preseed files colourfully." + (interactive) + (kill-all-local-variables) + (setq comment-start "#" + comment-multi-line nil + comment-start-skip "#+[\t ]*") + (setq major-mode 'preseed-mode + mode-name "Preseed" + local-abbrev-table preseed-mode-abbrev-table) + (run-hooks 'preseed-mode-hook) + (set (make-local-variable 'font-lock-defaults) + '(preseed-font-lock-keywords nil nil ((?_ . "w"))))) + +(provide 'preseed) + +;;; preseed.el ends here diff --git a/elisp/devscripts-el/ChangeLog b/elisp/devscripts-el/ChangeLog new file mode 100755 index 0000000..b6a5287 --- /dev/null +++ b/elisp/devscripts-el/ChangeLog @@ -0,0 +1,322 @@ +2005-08-21 Junichi Uekawa + + * pbuilder-mode.el (pbuilder-build, pbuilder-user-mode-linux-build): + add \n after 'start compile' message + +2003-10-18 Junichi Uekawa + + * devscripts.el (debdiff): add new function, debdiff + +2003-10-05 Junichi Uekawa + + * Moved all files to alioth. + +2003-09-27 Junichi Uekawa + + * pbuilder-mode.el (pdebuild-user-mode-linux): set buffer-process-coding-system to dos for user-mode-linux output. + fix bug. + (pbuilder-user-mode-linux-build): fix. + +2003-09-18 Junichi Uekawa + + * readme-debian.el: remove from here, alioth has the latest. + * debian-copyright.el: remove from here, alioth has the latest. + +2003-08-25 Junichi Uekawa + + * readme-debian.el (readme-debian-mode): use write-contents-hooks + instead of write-file-hooks, and do not make-local-variable, but + use the add-hook and LOCAL flag. + +2003-06-25 Junichi Uekawa + + * debian-copyright.el: add patch from PSG for font-lock problem in + Xemacs. + +2003-05-25 Junichi Uekawa + + * readme-debian.el: Applied patch from Peter S Galbraith + +2003-05-21 Junichi Uekawa + + * readme-debian.el: accept patch from Peter S Galbraith + for byte-compilation fixes and many cosmetic fixes. + +2003-05-16 Junichi Uekawa + + * readme-debian.el: defgroup/defcustom. + + * pbuilder-log-view-mode.el (pbuilder-log-view-web-basepath): + renamed from pbuilder-log-web-basepath + Change to defgroup/custom. + + * devscripts.el: defgroup. + + * pbuilder-mode.el (pbuilder-mode): defgroup, + and change to defcustom. + +2003-05-14 Junichi Uekawa + + * debian-copyright.el (debian-copyright): fix typo. + (debian-copyright): include patch from Peter S Galbraith. + +2003-05-12 Junichi Uekawa + + * debian-copyright.el: include patch from Peter S Galbraith , who has rewrote most of debian-copyright.el + +2003-04-02 Junichi Uekawa + + * devscripts.el (debclean): add debclean + +2003-02-10 Junichi Uekawa + + * pbuilder-mode.el (pdebuild-user-mode-linux): new function. + (pdebuild-user-mode-linux-path): new variable. + +2003-01-08 Junichi Uekawa + + * pbuilder-mode.el (debuild-pbuilder): convert debuild-pbuilder + to make-comint. + (pbuilder-user-mode-linux-path, pbuilder-user-mode-linux-build): + support pbuilder-user-mode-linux. + +2003-01-07 Junichi Uekawa + + * devscripts.el (debi): try to use comint for starting up, + so that it can run interactive. + +2002-11-27 Junichi Uekawa + + * readme-debian.el (readme-debian-font-lock-keywords) + (readme-debian-mode): Apply patch from + James LewisMoss to make this thing + work with xemacs, and then revert the patch because that + does not really work with emacs21. + +2002-11-10 Junichi Uekawa + + * pbuilder-mode.el: done checkdoc. + + * devscripts.el (devscripts-mode-gain-root-command): done checkdoc. + + * readme-debian.el: done checkdoc. + + * debian-copyright.el: done checkdoc + +2002-10-30 Junichi Uekawa + + * Makefile (distimage): add COPYING file. + + * pbuilder-mode.el (debuild-pbuilder): use debuild-option-list + + * pbuilder-log-view-mode.el (pbuilder-log-view-internal-garbage-collect-log): check the title as well ? + I will only be able to match via title page. + + * pbuilder-mode.el (debuild-pbuilder): introduce debuild-pbuilder function for running debuild-pbuilder hack. + + * pbuilder-log-view-mode.el (pbuilder-log-view-build-result-alist-mutex): change names + (pbuilder-log-view-build-result-alist): change names from debuild-* + +2002-10-29 Junichi Uekawa + + * pbuilder-log-view-mode.el (pbuilder-log-view-add): use mutex lock + (pbuilder-log-view-lock-mutex): mutex lock implementation + (pbuilder-log-view-internal-function): lock mutex. + (mcharset): require. + (pbuilder-log-view-internal-view-one-log): ran checkdoc, and fixed some text. + (pbuilder-log-view-internal-view-one-log): try and use relative paths now. + (pbuilder-log-view-elserv): publish one base path. + (pbuilder-log-view-internal-function): remove the hack to generate list of + available web pages. + + * pbuilder-mode.el (pdebuild): use pbuilder-log-view-add + (pbuilder-build): ditto + + * pbuilder-log-view-mode.el (pbuilder-log-view-add): new function + + * devscripts.el (debuild): use pbuilder-log-view-add function + +2002-10-28 Junichi Uekawa + + * pbuilder-log-view-mode.el (pbuilder-log-view-internal-function): move the function + location to avoid locking up. + garbage collector needs to lock variables, it seems. + (pbuilder-log-view-internal-garbage-collect-log): reverse the listing. + + * htmlize.el (htmlize-buffer-noninteractive): new hack from upstream. + + * pbuilder-log-view-mode.el (pbuilder-log-view-mode): change to + match filename. + (pbuilder-log-web-basepath): move from pbuilder-mode.el + (pbuilder-log-view-internal-garbage-collect-log): try garbage collection. + (pbuilder-log-view-internal-function): try garbage collecting before start. + (pbuilder-log-view-internal-view-one-log): use htmlize-buffer-noninteractive, provided by 0.68? of htmlize.el + + * pbuilder-mode.el (pbuilder-log-view): require. + + * devscripts.el (pbuilder-log-view): require. + + * pbuilder-log-view-mode.el (pbuilder-log-view): provide pbuilder-log-view + + * Makefile (clean): add clean rule. + + * pbuilder-mode.el: remove things from here. + * pbuilder-log-view-mode.el: new file, move things related to logview mode over here. + + * htmlize.el: modified last night, merging the modified version into the tree + until this thing is fixed upstream. + + * pbuilder-mode.el (pbuilder-log-view-elserv): add description + (pdebuild): fixed typo. + +2002-10-27 Junichi Uekawa + + * pbuilder-mode.el (pbuilder-build): give process information for debuild-results-alist + (pdebuild): ditto. + (pbuilder-log-view-internal-function): change the page to use running-status + of process if it is available. + (pbuilder-log-view-internal-function): running-status and exit-status are now used to + generate information. + (pbuilder-log-view-internal-function): add current time to last-updated string ;) + (pbuilder-log-view-internal-function): reorganized to use with-temp-buffer instead of + a massive string variable + (pbuilder-log-view-internal-view-one-log): set-buffer instead of swith-to-buffer + (pbuilder-log-view-internal-view-one-log): use save-excursion instead of save-window-excursion + (pbuilder-log-view-internal-function): use set-buffer + (pbuilder-log-view-internal-view-one-log): change back to save-window-excursion + (pbuilder-log-view-internal-view-one-log): use a newly hacked htmlize-buffer. + + * devscripts.el (debuild-option-list): add -us and -uc, because there is no + reasonable way (currently) to sign debuilt package inside emacs. + (debuild): add process information as third member of debuild-results-alist + + * pbuilder-mode.el (pbuilder-log-view-internal-view-one-log): use htmlize-buffer. + (pbuilder-log-view-internal-view-one-log): kill the htmlized buffer after sending the info. + (pbuilder-log-view-elserv): require 'htmlize on starting the server, because + logs are htmlized. + (pbuilder-log-view-internal-view-one-log): I don't need the concat of progname here. + +2002-10-26 Junichi Uekawa + + * readme-debian.el (readme-debian-mode-load-hook): add * + (readme-debian-mode-hook): new var. + + * pbuilder-mode.el (pbuilder-path, pdebuild-path) + (pbuilder-log-web-basepath): add * + + * devscripts.el (debuild-option-list): add * + (devscripts-mode-gain-root-command): add * + (devscripts-mode-load-hook): add * + + * debian-copyright.el (debian-copyright-mode-load-hook): add * to + documentation string for customizable value. + +2002-10-25 Junichi Uekawa + + * debian-copyright.el (debian-copyright-mode-version): add version string. + + * devscripts.el (devscripts-mode-version): add version string. + + * pbuilder-mode.el (pbuilder-log-view-function): support charsets. + (pbuilder-log-view-elserv, pbuilder-log-view-internal-function): rename function to add "internal" + (pbuilder-log-view-internal-function) + (pbuilder-log-view-internal-view-one-log): experimental dynamic log generation. + (pbuilder-log-view-internal-function): update to be dynamic. + (pbuilder-log-view-internal-function): provide only the dynamic pages. + (pbuilder-log-view-elserv): add more notes to the program. + (pbuilder-mode-version): add version string. + + * devscripts.el (debuild): use devscripts-internal-get-debian-package-name to record the build log. + + * pbuilder-mode.el (pdebuild): use devscripts-internal-get-debian-package-name instead. + + * devscripts.el (debuild-results-alist): move over to devscripts, + from pbuilder var. + (devscripts-internal-get-debian-package-name): new func to get dirname. + + * pbuilder-mode.el (pbuilder-log-view-function) + (pbuilder-log-web-basepath, pbuilder-log-view-elserv): use pbuilder-log-web-basepath + as a variable to define the path for the build logs. + (pbuilder-build): fix name-getting. + (pbuilder-build): use filename instead of default-directory as identifier. + +2002-10-24 Junichi Uekawa + + * pbuilder-mode.el (pbuilder-results-alist): alist for pbuilder + results. + (pdebuild): get the current package name that is being built, and + set the name. + (pbuilder-build): support adding the build log. + (pbuilder-log-view-function): Implementation of elserv log viewer + for pbuilder session. + + * devscripts.el (debuild-option-list): introduce new option. + (debuild): use the option, with apply command, etc. + + * pbuilder-mode.el (pbuilder-build, pdebuild, pdebuild-path) + (pbuilder-path): define variable to specify pbuilder and pdebuild path. + +2002-10-23 Junichi Uekawa + + * pbuilder-mode.el (pdebuild): new file, new code. + (pbuilder-build): implement. + Use devscripts mode variables. + (pbuilder-build): update, use expand-file-name + + * devscripts.el (debuild): add -i option. I want to make this optional. + +2002-10-20 Junichi Uekawa + + * debian-copyright.el (debian-copyright-mode-load-hook): add + + * readme-debian.el (readme-debian-mode-load-hook): add + + * devscripts.el (devscripts-mode-load-hook): add. + +2002-10-19 Junichi Uekawa + + * debian-copyright.el (debian-copyright-mode): create default. + + * readme-debian.el (readme-debian-mode): add mode map doc. + + * debian-copyright.el (auto-mode-alist): create, modify. + + * devscripts.el: add copyright. + +2002-10-17 Junichi Uekawa + + * readme-debian.el (debian-changelog-mode): require debian-changelog-mode + (readme-debian-mode): provide readme-debian-mode, not readme-debian + (readme-debian-update-timestamp): use variables from debian-changelog mode, + not invent my own. + + * devscripts.el: provide devscripts. + +2002-10-16 Junichi Uekawa + + * readme-debian.el: update copyright. + + * devscripts.el (devscripts-debc-mode-syntax-table): fix. + (debi, debit): change, new debit function. Use devscripts-mode-gain-root-command + (devscripts-mode-gain-root-command): new var. + + * readme-debian.el (readme-debian-mode-syntax-table): fix readme-debian-mode-syntax-table. + + * readme-debian.el (readme-debian-mode): add ^[-=]+$ to highlight + (auto-mode-alist): add README.Debian in /usr/share/doc + + * Makefile (RELEASE): create make rules. + +2002-10-15 Junichi Uekawa + + * readme-debian.el (readme-debian-mode): implemented something un-cool about this... + I've done a README.Debian syntax highlighter + (readme-debian-update-timestamp): create a function to change timestamp. + (readme-debian-mode): and add hook to use that function on file write. + (auto-mode-alist): add reamde-debian-mode to auto-mode-alist. + + * devscripts.el (debc, debi, debuild): import from .emacs of myself. + (devscripts-debc-mode): create a good fontmap, so that things are highlighted properly. + + Copyright GPL. + diff --git a/elisp/devscripts-el/devscripts.el b/elisp/devscripts-el/devscripts.el new file mode 100755 index 0000000..4c6e64c --- /dev/null +++ b/elisp/devscripts-el/devscripts.el @@ -0,0 +1,178 @@ +;; Routines to do devscripts-compatible emacs routines. +;; copyright 2002 Junichi Uekawa. + +;; 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. +;; +;; readme-debian.el 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 your Debian installation, in /usr/share/common-licenses/GPL +;; If not, write to the Free Software Foundation, 675 Mass Ave, +;; Cambridge, MA 02139, USA. + +(require 'pbuilder-log-view-mode) +(require 'comint) + +(defgroup devscripts nil "devscripts mode" + :group 'tools + :prefix "devscripts-") + + +(defcustom debuild-option-list '("-i" "-uc" "-us") "*Options to give to debuild." + :type '(repeat string) + :group 'devscripts) +(defconst devscripts-mode-version "$Id: devscripts.el,v 1.5 2007-07-13 15:13:30 dancer Exp $" "Version of devscripts mode.") + +(defun devscripts-internal-get-debian-package-name () + "Find the directory with debian/ dir, and get the dir name." + (let* ((looking-dir (expand-file-name (concat default-directory ".")))) + (while (not (file-accessible-directory-p (concat looking-dir "/debian"))) + (progn + (if (string= looking-dir "/") + (error "Cannot find debian dir anywhere")) + (setq looking-dir (expand-file-name (expand-file-name (concat looking-dir "/..")))))) + (file-name-nondirectory looking-dir))) + +(defun debuild () + "Run debuild in the current directory." + (interactive) + (let* ((debuild-buffer (concat "*debuild*" default-directory)) + (debuild-process (concat "debuild-process-" default-directory)) + (package-name (devscripts-internal-get-debian-package-name))) + (switch-to-buffer debuild-buffer) + (toggle-read-only 0) + (kill-region (point-min) (point-max)) + (compilation-mode) + (pbuilder-log-view-add package-name debuild-buffer (apply 'start-process debuild-process debuild-buffer "/usr/bin/debuild" debuild-option-list)))) + +(defun debi () + "Run debi in the current directory, to install debian packages generated by previous invocation of debuild." + (interactive) + (let* ((debi-name (concat "debi" default-directory)) + (debi-buffer-name (concat "*" debi-name "*"))) + (make-comint debi-name devscripts-mode-gain-root-command + nil "/usr/bin/debi") + (switch-to-buffer debi-buffer-name))) + +(defun debit () + "Run debit in the current directory, to install debian packages generated by previous invocation of debuild." + (interactive) + (let* ((debit-buffer (concat "*debit*" default-directory)) + (debit-process (concat "debit-process-" default-directory))) + (switch-to-buffer debit-buffer) + (kill-region (point-min) (point-max)) + (compilation-mode) + (start-process debit-process debit-buffer devscripts-mode-gain-root-command "/usr/bin/debit"))) + + +(defun debc () + "Run debc in the current directory, to install debian packages generated by previous invocation of debuild." + (interactive) + (let* ((debc-buffer (concat "*debc*" default-directory)) + (debc-process (concat "debc-process-" default-directory))) + (switch-to-buffer debc-buffer) + (kill-region (point-min) (point-max)) + (devscripts-debc-mode) + (start-process debc-process debc-buffer "/usr/bin/debc"))) + +(defun debclean () + "Run debclean in the current directory, to clean the debian build tree." + (interactive) + (let* ((debclean-buffer (concat "*debclean*" default-directory)) + (debclean-process (concat "debclean-process-" default-directory))) + (switch-to-buffer debclean-buffer) + (kill-region (point-min) (point-max)) + (compilation-mode) + (start-process debclean-process debclean-buffer "/usr/bin/debclean"))) + +(defun debdiff (changes-file-1 changes-file-2) + "Compare contents of CHANGES-FILE-1 and CHANGES-FILE-2." + (interactive "fFirst Changes file: \nfSecond Changes File: ") + (let* ((debdiff-buffer (concat "*debdiff*" default-directory)) + (debdiff-process (concat "debdiff-process-" default-directory))) + (switch-to-buffer debdiff-buffer) + (kill-region (point-min) (point-max)) + (start-process debdiff-process debdiff-buffer "/usr/bin/debdiff" + (expand-file-name changes-file-1) + (expand-file-name changes-file-2)))) + +(defun debdiff-current () + "Compare the contents of .changes file of current version with previous version; +requires access to debian/changelog, and being in debian/ dir." + (interactive) + (let* ((debdiff-buffer (concat "*debdiff*" default-directory)) + (debdiff-process (concat "debdiff-process-" default-directory)) + (debug-on-error t) + newversion oldversion pkgname changes-file-1 changes-file-2) + (find-file "changelog") + (save-excursion + (goto-char (point-min)) + (re-search-forward "^\\(\\S-+\\) +(\\([^:)]*:\\)?\\([^)]*\\))" nil t) + (setq newversion (match-string 3)) + (setq pkgname (match-string 1)) + (re-search-forward "^\\(\\S-+\\) +(\\([^:)]*:\\)?\\([^)]*\\))" nil t) + (setq oldversion (match-string 3))) + (setq changes-file-1 + (car (file-expand-wildcards (concat default-directory "../../" pkgname "_" oldversion "_*.changes")))) + (setq changes-file-2 + (car (file-expand-wildcards (concat default-directory "../../" pkgname "_" newversion "_*.changes")))) + (princ pkgname) + (princ oldversion) + (princ changes-file-1) + (princ changes-file-2) + (switch-to-buffer debdiff-buffer) + (kill-region (point-min) (point-max)) + (insert (concat + "Comparing " + (file-name-nondirectory changes-file-1) " and " + (file-name-nondirectory changes-file-2) "\n")) + (start-process debdiff-process debdiff-buffer "/usr/bin/debdiff" + (expand-file-name changes-file-1) + (expand-file-name changes-file-2)))) + +(defun devscripts-debc-mode () + "Mode to view debc output. +\\{devscripts-debc-mode-map}" + (interactive) + (kill-all-local-variables) + (setq major-mode 'devscripts-debc-mode) + (setq mode-name "debc") + (mapcar 'make-local-variable '(font-lock-defaults)) + (use-local-map devscripts-debc-mode-map) + (set-syntax-table devscripts-debc-mode-syntax-table) + (setq font-lock-defaults + '( + ;keywords start here + (("^[a-z].*deb$" . font-lock-string-face) + ("^ \\([A-Z][-A-Za-z]+:\\)\\(.*\\)$" (1 font-lock-keyword-face) (2 font-lock-warning-face)) + ("^[^ ].*$" . font-lock-comment-face) + ) + nil ;keywords-only + nil ;case-fold + () ;syntax-alist + )) + (run-hooks 'devscripts-debc-mode-hook) +) + +(defvar devscripts-debc-mode-map nil "Keymap for devscripts debc mode.") +(defvar devscripts-debc-mode-syntax-table nil "Syntax table for devscripts debc mode.") +(if devscripts-debc-mode-syntax-table + () ; Do not change the table if it is already set up. + (setq devscripts-debc-mode-syntax-table (make-syntax-table)) + (modify-syntax-entry ?\" ". " devscripts-debc-mode-syntax-table) + (modify-syntax-entry ?\\ ". " devscripts-debc-mode-syntax-table) + (modify-syntax-entry ?' "w " devscripts-debc-mode-syntax-table)) +(defcustom devscripts-mode-gain-root-command "/usr/bin/sudo" "*The command used to gain root for running debi and debit." + :group 'devscripts + :type 'file) +(defcustom devscripts-mode-load-hook nil "*Hooks that are run when devscripts-mode is loaded." + :group 'devscripts + :type 'hook) +(run-hooks 'devscripts-mode-load-hook) +(provide 'devscripts) diff --git a/elisp/devscripts-el/pbuilder-log-view-mode.el b/elisp/devscripts-el/pbuilder-log-view-mode.el new file mode 100755 index 0000000..db3db13 --- /dev/null +++ b/elisp/devscripts-el/pbuilder-log-view-mode.el @@ -0,0 +1,244 @@ +;; Routines to do devscripts-compatible emacs routines. +;; copyright 2002 Junichi Uekawa. + +;; 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. +;; +;; readme-debian.el 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 your Debian installation, in /usr/share/common-licenses/GPL +;; If not, write to the Free Software Foundation, 675 Mass Ave, +;; Cambridge, MA 02139, USA. + +(require 'mcharset) +(defgroup pbuilder-log-view nil "Pbuilder log view mode" + :group 'tools + :prefix "pbuilder-log-view-") + +(defcustom pbuilder-log-view-web-basepath "/~pbuilder/" "*Elserv path to pbuilder logs." + :type 'string + :group 'pbuilder-log-view) + +(defvar pbuilder-log-view-build-result-alist nil + "Associated list of results of the pbuilder/debuild runs. +They are in (package result-buffer-name process-name(if process exists)) + +When this variable is being accessed, set `pbuilder-log-view-build-result-alist-mutex' to t.") + +(defvar pbuilder-log-view-build-result-alist-mutex nil + "The access-control for `pbuilder-log-view-build-result-alist'. +If someone is accessing that var, it is t") + +;; potential new interface? +(defvar pbuilder-log-view-results-plist nil + "Property list of results of the pbuilder/debuild runs. +:package +:result-buffer-name +:process-name") + +;; mutex lock implementation thanks to TSUCHIYA Masatoshi +(defmacro pbuilder-log-view-lock-mutex (mutex &rest body) + "Try to mutex-lock a variable MUTEX, and run BODY. + +The MUTEX needs to be nil." + `(progn + (while ,mutex + (accept-process-output nil 0 200)) + (setq ,mutex t) + ,@body + (setq ,mutex nil))) + +;; The following code does publishing for elserv. +;; elserv-start, then run pbuilder-log-view-elserv + +(defun pbuilder-log-view-add (package-name buffer-name running-process) + "Add the entry to the log view list. + +\(PACKAGE-NAME, BUFFER-NAME, RUNNING-PROCESS\) will be added to +`pbuilder-log-view-build-result-alist'. + +Argument PACKAGE-NAME is the name of the package." + (pbuilder-log-view-lock-mutex + pbuilder-log-view-build-result-alist-mutex + (add-to-list 'pbuilder-log-view-build-result-alist (list package-name buffer-name running-process)))) + +(defun pbuilder-log-view-internal-garbage-collect-log () + "Remove unneeded entries from the log listing." + (setq pbuilder-log-view-build-result-alist + (let* (new-data current-is-okay) + (dolist (entry pbuilder-log-view-build-result-alist) + (setq current-is-okay t) + (if (get-buffer (cadr entry)) + (dolist (new-data-element new-data) + (if (string= (cadr new-data-element) (cadr entry)) + (setq current-is-okay nil)) + (if (string= (car new-data-element) (car entry)) + (setq current-is-okay nil))) + (setq current-is-okay nil)) + (if current-is-okay + (add-to-list 'new-data entry))) + (reverse new-data)))) + +(defun pbuilder-log-view-internal-view-one-log (result path ppath request) + "View one logfile from buffer. + +Requires a newish htmlize.el +RESULT is the resulting value +PATH is relative path from the published path +PPATH is the published path +REQUEST is the request data." + (let* (logname matching-assoc nowlist charset) + (string-match "/\\?\\(.+\\).html$" path) + (setq logname (match-string 1 path)) + (setq nowlist (assoc logname pbuilder-log-view-build-result-alist)) + (if nowlist + (save-window-excursion + (if (get-buffer (cadr nowlist)) + (progn + (let* ((htmlize-major-mode nil)) + (set-buffer (htmlize-buffer-noninteractive (cadr nowlist)))) + (setq charset (detect-mime-charset-region (point-min)(point-max))) + (elserv-set-result-header + result + (list 'content-type (concat "text/html; charset=" (symbol-name charset)))) + (elserv-set-result-body result + (encode-mime-charset-string (buffer-string) charset)) + (kill-buffer (current-buffer))) + (elserv-set-result-header result (list 'content-type (concat "text/plain"))) + (elserv-set-result-body result "404?"))) + (elserv-set-result-header result (list 'content-type (concat "text/plain"))) + (elserv-set-result-body result "404p")))) + +;; some code sampled from remote.el from elserv sources. +(defun pbuilder-log-view-internal-function (result path ppath request) + "Elserv publish function for pbuilder logs. +RESULT, PATH, PPATH and REQUEST are arguments + +This page presents the list of build logs available from this Emacs session" + (pbuilder-log-view-lock-mutex + pbuilder-log-view-build-result-alist-mutex + (pbuilder-log-view-internal-garbage-collect-log)) + (save-window-excursion + (with-temp-buffer + (elserv-set-result-header result + '(content-type "text/html")) + (insert (concat " + + +List of builds + + + +

List of builds done in the emacs session

+

Last updated:" + (current-time-string) + "

\n")) + (elserv-set-result-body + result + (buffer-string)))))) + +(defcustom pbuilder-log-view-css " +BODY{ +color: #ffeeee; +background-color: #000055; +} +h1.title{ + margin-top: 0em; + border-color: #99c; + border-width: 0px 9px 4px 0px; + border-style: solid; +} +div.listing{ + margin-top: 0em; + border-color: #99c; + border-width: 0px 0px 4px 9px; + border-style: solid; +} +li.package{ +} +a:link { + color: #ffccff; +} +a:active { + color: #eeeeee; +} +a:hover { + color: #ffffff; + background-color: #5555ff; +} +a:visited { + color: #ddeedd; +} +span.status{ + color: #ffffff; + background-color: #000000; +} +span.buildfail{ + color: #ff3300; + background-color: #000000; +} +span.buildsuccess{ + color: #00aaff; + background-color: #000000; +} +" "*Css-string to be added to pbuilder log listing view html page. +h1.title +div.listing +ul.listing +li.package +a.package +span.status +span.buildfail +span.buildsuccess" + :type 'text + :group 'pbuilder-log-view) + +(defun pbuilder-log-view-elserv () + "Run a elserv session with log view. + +Running this requires elserv. Use elserv, and do `elserv-start' before invoking this command." + (interactive) + (require 'elserv) + (require 'htmlize) + (elserv-publish (elserv-find-process) + pbuilder-log-view-web-basepath + :function 'pbuilder-log-view-internal-function + :description "Build log listing" + ) + (elserv-publish (elserv-find-process) + (concat pbuilder-log-view-web-basepath "query.cgi") + :function 'pbuilder-log-view-internal-view-one-log + :description "Build log database query")) + + +(provide 'pbuilder-log-view-mode) + + diff --git a/elisp/devscripts-el/pbuilder-mode.el b/elisp/devscripts-el/pbuilder-mode.el new file mode 100755 index 0000000..c24770a --- /dev/null +++ b/elisp/devscripts-el/pbuilder-mode.el @@ -0,0 +1,122 @@ +;; Routines to do devscripts-compatible emacs routines. +;; copyright 2002 Junichi Uekawa. + +;; 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. +;; +;; readme-debian.el 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 your Debian installation, in /usr/share/common-licenses/GPL +;; If not, write to the Free Software Foundation, 675 Mass Ave, +;; Cambridge, MA 02139, USA. + +(require 'devscripts) +(require 'pbuilder-log-view-mode) + +(defgroup pbuilder nil "PBuilder mode" + :group 'tools + :prefix "pbuilder-mode-") + +(defcustom pbuilder-path "/usr/sbin/pbuilder" + "*Path to pbuilder." + :group 'pbuilder + :type 'file) +(defcustom pbuilder-user-mode-linux-path "/usr/bin/pbuilder-user-mode-linux" "*Path to pbuilder-user-mode-linux." + :group 'pbuilder + :type 'file) +(defcustom pdebuild-path "/usr/bin/pdebuild" "*Path to pdebuild." + :group 'pbuilder + :type 'file) +(defcustom pdebuild-user-mode-linux-path "/usr/bin/pdebuild-user-mode-linux" "*Path to pdebuild-user-mode-linux." + :group 'pbuilder + :type 'file) +(defcustom debuild-pbuilder-path "/usr/bin/debuild-pbuilder" "*Path to `debuild-pbuilder'." + :group 'pbuilder + :type 'file) +(defconst pbuilder-mode-version "$Id: pbuilder-mode.el,v 1.3 2007-07-14 09:26:05 dancer Exp $" "Version of pbuilder mode.") + +(defun pdebuild () + "Run pdebuild in the current directory." + (interactive) + (let* ((pdebuild-buffer (concat "*pdebuild*" default-directory)) + (pdebuild-process (concat "pdebuild-process-" default-directory)) + (package-name (devscripts-internal-get-debian-package-name))) + (switch-to-buffer pdebuild-buffer) + (toggle-read-only 0) + (kill-region (point-min) (point-max)) + (compilation-mode) + (pbuilder-log-view-add + package-name pdebuild-buffer + (start-process pdebuild-process pdebuild-buffer pdebuild-path)))) + +(defun pdebuild-user-mode-linux () + "Run pdebuild-user-mode-linux in the current directory." + (interactive) + (let* ((pdebuild-buffer (concat "*pdebuild*" default-directory)) + (pdebuild-process (concat "pdebuild-process-" default-directory)) + (package-name (devscripts-internal-get-debian-package-name))) + (switch-to-buffer pdebuild-buffer) + (toggle-read-only 0) + (kill-region (point-min) (point-max)) + (compilation-mode) + (pbuilder-log-view-add + package-name pdebuild-buffer + (start-process pdebuild-process pdebuild-buffer pdebuild-user-mode-linux-path)) + (set-buffer-process-coding-system 'dos 'dos))) + +(defun debuild-pbuilder () + "Run `debuild-pbuilder' in the current directory." + (interactive) + + (let* ((pdebuild-name (concat "debuild-pbuilder" default-directory)) + (pdebuild-buffer (concat "*" pdebuild-name "*" )) + (pdebuild-process (concat "debuild-pbuilder-process-" default-directory)) + (package-name (devscripts-internal-get-debian-package-name))) + (switch-to-buffer pdebuild-buffer) + (toggle-read-only 0) + (kill-region (point-min) (point-max)) + (pbuilder-log-view-add + package-name + (apply 'make-comint pdebuild-name debuild-pbuilder-path nil + debuild-option-list) + (get-process pdebuild-name)))) + +(defun pbuilder-build (filename) + "Run pbuilder build for a given FILENAME. +Uses `devscripts-mode-gain-root-command' as command to gain root." + (interactive "f.dsc File name: ") + (let* ((pbuilder-buffer (concat "*pbuilder-build*" filename)) + (pbuilder-process (concat "pbuilder-build-process-" filename))) + (switch-to-buffer pbuilder-buffer) + (toggle-read-only 0) + (kill-region (point-min) (point-max)) + (compilation-mode) + (insert "start compile\n") + (pbuilder-log-view-add + (file-name-sans-extension (file-name-nondirectory filename)) pbuilder-buffer + (start-process pbuilder-process pbuilder-buffer devscripts-mode-gain-root-command pbuilder-path "build" (expand-file-name filename))))) + +(defun pbuilder-user-mode-linux-build (filename) + "Run pbuilder-user-mode-linux build for a given FILENAME. " + (interactive "f.dsc File name: ") + (let* ((pbuilder-buffer (concat "*pbuilder-uml-build*" filename)) + (pbuilder-process (concat "pbuilder-uml-build-process-" filename))) + (switch-to-buffer pbuilder-buffer) + (toggle-read-only 0) + (kill-region (point-min) (point-max)) + (compilation-mode) + (insert "start compile\n") + (pbuilder-log-view-add + (file-name-sans-extension (file-name-nondirectory filename)) pbuilder-buffer + (start-process pbuilder-process pbuilder-buffer pbuilder-user-mode-linux-path "build" (expand-file-name filename))) + (set-buffer-process-coding-system 'dos 'dos))) + + + +(provide 'pbuilder-mode) diff --git a/elisp/dpkg-dev-el/debian-bts-control.el b/elisp/dpkg-dev-el/debian-bts-control.el new file mode 100755 index 0000000..7ecae22 --- /dev/null +++ b/elisp/dpkg-dev-el/debian-bts-control.el @@ -0,0 +1,1231 @@ +;;; debian-bts-control.el --- Create messages for Debian BTS control interface + +;; Copyright (C) 2003, 2005, 2007, 2009 Peter S Galbraith +;; +;; Help text from http://www.debian.org/Bugs/server-control: +;; Debian BTS administrators +;; Copyright 1999 Darren O. Benham, 1994-1997 Ian Jackson, +;; 1997 nCipher Corporation Ltd. +;; +;; 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. +;; +;; debian-bts-mode.el 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 your Debian installation, in /usr/share/common-licenses/GPL +;; If not, write to the Free Software Foundation, 675 Mass Ave, +;; Cambridge, MA 02139, USA. + +;;; Commentary: +;; +;; Use `M-x debian-bts-control' to create an initial message, and +;; `M-x debian-bts-control' again (or `C-c C-b') to insert new directives. + +;;; Change log: +;; +;; V1.00 30apr2003 Peter S Galbraith +;; - Initial release. +;; V1.01 23May2003 Peter S Galbraith +;; - Add `debian-bts-control-modes-to-reuse'. +;; V1.02 09Aug2003 Peter S Galbraith +;; - add `debian-bts-control-prompt' to Prompt for bug number using sensible +;; default if found. +;; V1.03 03Sep2003 Peter S Galbraith +;; - Don't set `debian-bts-control-verbose-prompts-flag' to t for Emacs20 +;; since it can't display multi-line prompts. (Closes: #208553) +;; V1.04 05Sep2003 Peter S Galbraith +;; - debian-bts-help-control: was missing! +;; V1.05 18Sep2003 Peter S Galbraith +;; - Add `package', `owner' and `noowner'. +;; V1.06 05Oct2003 Peter S Galbraith +;; - Add tags "sarge-ignore" and "fixed-uptsream". +;; V1.07 03Nov2003 Peter S Galbraith +;; - Created defgroup debian-bts-control. +;; V1.08 20Nov2005 Peter S Galbraith +;; - patch from Jari Aalto : +;; It is now possible to put point at "Bug#NNNN" e.g. in debian/changelog +;; and use that as default number. +;; (top level): Added '(require 'cl) +;; (debian-bts-bug-number-at-point): New function. +;; (debian-bts-control-prompt): Code structure slightly redesigned. +;; (debian-bts-control): Use `debian-bts-bug-number-at-point' to +;; set `number-default'. +;; V1.08 08Aug2007 Peter S Galbraith +;; - Use `C-c C-b' instead of `C-c c' (Closes: #435247). +;; V1.09 30Aug2007 Peter S Galbraith +;; - skip over mml directives (Closes: #392132) +;; V1.10 30Aug2007 Peter S Galbraith +;; - Add `fixed' `notfixed' `block' `unblock' `archive' `unarchive' +;; `found' `notfound'. (Closes: #391647) +;; V1.11 23Feb2009, Patch from Luca Capello . +;; - Add `debian-bts-control-cc-or-bcc' (Closes: #392494) +;; V1.12 11Nov2009 Peter S Galbraith +;; - Add `debian-bts-emailaddress' and `debian-bts-emaildomain'. +;; - Add command `emacs-bts-control', new command to interface with Emacs BTS. +;; V1.13 21Nov2009 Peter S Galbraith +;; - Patches from Sven Joachim (Closes: #557408, #557412) +;; V1.14 19Dec2009 Peter S Galbraith +;; - Emacs BTS moved to debbugs.gnu.org +;; V1.15 22Feb2010 Peter S Galbraith +;; - add autoload cookie for `emacs-bts-control' (Closes: #565934) +;; V1.16 05Nov2016 Peter S Galbraith +;; Bug fix: "please add all BTS commands (e.g. affects and usertags)", +;; thanks to Luca Capello (Closes: #643888). +;; - Add `affects', `forcemerge', `summary' and font-lock for `tag'. +;; - Remove `close' +;;; Code: + +(eval-when-compile '(require 'cl)) +(require 'debian-bug) +(autoload 'word-at-point "thingatpt") + +(defgroup debian-bts-control nil + "Create messages for Debian BTS control interface" + :group 'debian-bug) + +(defcustom debian-bts-control-verbose-prompts-flag t + "Non-nil means to be very verbose for `debian-bts-control' prompts." + :group 'debian-bts-control + :type 'boolean + :set (lambda (symbol value) + (if (<= 21 emacs-major-version) + (set-default symbol value) + (message + "debian-bts-control-verbose-prompts-flag overridden for Emacs20") + (set-default symbol nil)))) + +(defcustom debian-bts-control-modes-to-reuse + '(mh-letter-mode mail-mode message-mode) + "List of modes in which calling `debian-bts-control' will reuse the buffer. +No new draft will be created. Instead control@bugs.debian.org will be +added to the `debian-bts-control-cc-or-bcc' field and the commands added at +the top of the message." + :group 'debian-bts-control + :type '(repeat symbol)) + +(defcustom debian-bts-control-cc-or-bcc 'cc + "Whether to use Cc: or Bcc: header." + :group 'debian-bts-control + :type '(choice (const cc) (const bcc))) + +(defvar debian-bts-emailaddress "control@bugs.debian.org" + "Email address to send control message to.") + +(defvar debian-bts-emaildomain "bugs.debian.org" + "Email address domain to send control message to.") + +(defvar debian-bts-control-minor-mode nil) +(defvar debian-bts-control-minor-mode-map nil + "Keymap for `debian-bts-control' minor mode.") +(if debian-bts-control-minor-mode-map + nil + (setq debian-bts-control-minor-mode-map (make-sparse-keymap)) + (define-key debian-bts-control-minor-mode-map "\C-c\C-b" 'debian-bts-control)) + +(easy-menu-define debian-bts-control-menu debian-bts-control-minor-mode-map + "Debian Bug Mode Menu" + '("Control" + ("Header" + ["Custom From Address" (debian-bug--toggle-custom-From) + :style toggle :active debian-bug-From-address + :selected (debian-bug--is-custom-From)] + "--" + ["CC debian-devel" (debian-bug--toggle-CC-devel) + :style toggle + :selected (debian-bug--is-CC "debian-devel@lists.debian.org" "cc:")] + ["CC me" (debian-bug--toggle-CC-myself) + :style toggle :active debian-bug-From-address + :selected (debian-bug--is-CC debian-bug-From-address "cc:")] + ) + "--" + ["Affects" (debian-bts-control "affects") t] + ["Package" (debian-bts-control "package") t] + ["Reassign" (debian-bts-control "reassign") t] + ["Reopen" (debian-bts-control "reopen") t] + ["Owner" (debian-bts-control "owner") t] + ["NoOwner" (debian-bts-control "noowner") t] + ["Submitter" (debian-bts-control "submitter") t] + ["Forwarded" (debian-bts-control "forwarded") t] + ["NotForwarded" (debian-bts-control "notforwarded") t] + ["Retitle" (debian-bts-control "retitle") t] + ["Severity" (debian-bts-control "severity") t] + ["Summary" (debian-bts-control "summary") t] + ["Clone" (debian-bts-control "clone") t] + ["Merge" (debian-bts-control "merge") t] + ["ForceMerge" (debian-bts-control "forcemerge") t] + ["UnMerge" (debian-bts-control "unmerge") t] + ["Tags" (debian-bts-control "tags") t] + ["Close" (debian-bts-control "close") t] + "--" + ("Web View" + ["Bugs for a Package..." (debian-bug-web-bugs) t] + ["Bug Number..." (debian-bug-web-bug) t] + ["Package Info..." (debian-bug-web-packages) t] + ) + ["Customize" + (customize-group "debian-bug") (fboundp 'customize-group)] + ("Help" + ["Severities" (debian-bug-help-severity) t] + ["Tags" (debian-bug-help-tags) t] + ["Pseudo-Packages" (debian-bug-help-pseudo-packages) t] +;; ["Addresses" (debian-bug-help-email) t] + ["control commands" (debian-bts-help-control) t] + ) + )) + +;; - Add `fixed' `notfixed' `block' `unblock' `archive' `unarchive' +;; `found' `notfound'. (Closes: #391647) + +(defvar debian-bts-control-font-lock-keywords + '(("#.*$" . font-lock-comment-face) + ("^ *thank.*$" . font-lock-function-name-face) + ("^ *\\(summary\\) +\\(-?[0-9]+\\) *\\(.*\\)$" + (1 font-lock-function-name-face) + (2 font-lock-type-face) + (3 font-lock-string-face)) + ("^ *\\(affects\\) +\\(-?[0-9]+\\) *\\(.*\\)$" + (1 font-lock-function-name-face) + (2 font-lock-type-face) + (3 font-lock-string-face)) + ("^ *\\(found\\) +\\(-?[0-9]+\\) *\\(.*\\)$" + (1 font-lock-function-name-face) + (2 font-lock-type-face) + (3 font-lock-string-face)) + ("^ *\\(notfound\\) +\\(-?[0-9]+\\) +\\(.+\\)$" + (1 font-lock-function-name-face) + (2 font-lock-type-face) + (3 font-lock-string-face)) + ("^ *\\(archive\\) +\\(-?[0-9]+\\)$" + (1 font-lock-function-name-face) + (2 font-lock-type-face)) + ("^ *\\(unarchive\\) +\\(-?[0-9]+\\)$" + (1 font-lock-function-name-face) + (2 font-lock-type-face)) + ("^ *\\(block\\) +\\(-?[0-9]+\\) +\\(by\\) +\\(.+\\)$" + (1 font-lock-function-name-face) + (2 font-lock-type-face) + (3 font-lock-function-name-face) + (4 font-lock-string-face)) + ("^ *\\(unblock\\) +\\(-?[0-9]+\\) +\\(by\\) +\\(.+\\)$" + (1 font-lock-function-name-face) + (2 font-lock-type-face) + (3 font-lock-function-name-face) + (4 font-lock-string-face)) + ("^ *\\(fixed\\) +\\(-?[0-9]+\\) +\\(.+\\)$" + (1 font-lock-function-name-face) + (2 font-lock-type-face) + (3 font-lock-string-face)) + ("^ *\\(notfixed\\) +\\(-?[0-9]+\\) +\\(.+\\)$" + (1 font-lock-function-name-face) + (2 font-lock-type-face) + (3 font-lock-string-face)) + ("^ *\\(package\\) +\\([a-z0-9\\.\\-]+\\)$" + (1 font-lock-function-name-face) + (2 font-lock-keyword-face nil t)) + ("^ *\\(owner\\) +\\(-?[0-9]+\\) +\\(\\(!\\)\\|\\(.+\\)\\)$" + (1 font-lock-function-name-face) + (2 font-lock-type-face) + (4 font-lock-keyword-face nil t) + (5 font-lock-string-face nil t)) + ("^ *\\(noowner\\) +\\(-?[0-9]+\\)" + (1 font-lock-function-name-face) + (2 font-lock-type-face)) + ("^ *\\(reassign\\) +\\(-?[0-9]+\\) +\\([a-z0-9\\.\\-]+\\)$" + (1 font-lock-function-name-face) + (2 font-lock-type-face) + (3 font-lock-keyword-face nil t)) + ("^ *\\(reopen\\) +\\(-?[0-9]+\\) +\\(\\(!\\|=\\)\\|\\(.+\\)\\)$" + (1 font-lock-function-name-face) + (2 font-lock-type-face) + (4 font-lock-keyword-face nil t) + (5 font-lock-string-face nil t)) + ("^ *\\(submitter\\) +\\(-?[0-9]+\\) +\\(\\(!\\)\\|\\(.+\\)\\)$" + (1 font-lock-function-name-face) + (2 font-lock-type-face) + (4 font-lock-keyword-face nil t) + (5 font-lock-string-face nil t)) + ("^ *\\(forwarded\\) +\\(-?[0-9]+\\) +\\(.+\\)$" + (1 font-lock-function-name-face) + (2 font-lock-type-face) + (3 font-lock-string-face)) + ("^ *\\(notforwarded\\) +\\(-?[0-9]+\\)" + (1 font-lock-function-name-face) + (2 font-lock-type-face)) + ("^ *\\(retitle\\) +\\(-?[0-9]+\\) +\\(.+\\)$" + (1 font-lock-function-name-face) + (2 font-lock-type-face) + (3 font-lock-string-face)) + ("^ *\\(severity\\) +\\(-?[0-9]+\\) +\\(\\(critical\\|grave\\|serious\\)\\|\\(important\\)\\|\\(normal\\)\\|\\(\\(minor\\)\\|\\(wishlist\\)\\)\\)" + (1 font-lock-function-name-face) + (2 font-lock-type-face) + (4 font-lock-warning-face nil t) + (5 font-lock-keyword-name-face nil t) + (6 font-lock-type-face nil t) + (7 font-lock-string-face nil t)) + ("^ *\\(clone\\) +\\([0-9]+\\) +\\(-[0-9]+\\( +-[0-9]+\\)*\\)$" + (1 font-lock-function-name-face) + (2 font-lock-type-face) + (3 font-lock-keyword-face)) + ("^ *\\(merge\\) +\\(-?[0-9]+ +-?[0-9]+\\( +-?[0-9]+\\)*\\)$" + (1 font-lock-function-name-face) + (2 font-lock-type-face) + (3 font-lock-keyword-face)) + ("^ *\\(forcemerge\\) +\\(-?[0-9]+ +-?[0-9]+\\( +-?[0-9]+\\)*\\)$" + (1 font-lock-function-name-face) + (2 font-lock-type-face) + (3 font-lock-keyword-face)) + ("^ *\\(unmerge\\) +\\(-?[0-9]+\\)$" + (1 font-lock-function-name-face) + (2 font-lock-type-face)) + ("^ *\\(tags?\\) +\\(-?[0-9]+\\) +\\([-+=]? +\\)?\\(security\\)" + (1 font-lock-function-name-face) + (2 font-lock-type-face) + (3 font-lock-keyword-face nil t) + (4 font-lock-warning-face)) + ("^ *\\(tags?\\) +\\(-?[0-9]+\\) +\\([-+=]? +\\)?\\(patch\\|wontfix\\|moreinfo\\|unreproducible\\|help\\|pending\\|fixed-in-experimental\\|fixed-upstream\\|fixed\\|security\\|upstream\\|confirmed\\|d-i\\|ipv6\\|lfs\\|l10n\\|potato\\|woody\\|sarge-ignore\\|sarge\\|etch-ignore\\|etch\\|jessie\\|jessie-ignore\\|sid\\|experimental\\)" + (1 font-lock-function-name-face) + (2 font-lock-type-face) + (3 font-lock-keyword-face nil t) + (4 font-lock-keyword-face))) + "Regexp keywords to fontify `debian-bts-control' reports.") + +(defun debian-bts-control-minor-mode (arg) + "Toggle `debian-bts-control' mode. +A positive prefix argument ARG turns on `debian-bts-control' mode\; +a negative prefix argument turns it off. +\\ +\\[debian-bts-control]\t\tAdd a control command to the current message." + (interactive "P") + (set (make-local-variable 'debian-bts-control-minor-mode) + (if arg + (> (prefix-numeric-value arg) 0) + (not debian-bts-control-minor-mode))) + (cond + (debian-bts-control-minor-mode ;Setup the minor-mode + (if (fboundp 'font-lock-add-keywords) + (font-lock-add-keywords nil debian-bts-control-font-lock-keywords t)) + ))) + +;; Install ourselves: +(or (assq 'debian-bts-control-minor-mode minor-mode-alist) + (setq minor-mode-alist + (cons '(debian-bts-control-minor-mode " DBugC") minor-mode-alist))) +(or (assq 'debian-bts-control-minor-mode minor-mode-map-alist) + (setq minor-mode-map-alist + (cons (cons 'debian-bts-control-minor-mode + debian-bts-control-minor-mode-map) + minor-mode-map-alist))) + +(defvar debian-bts-control-alist + '(("reassign") ("severity") ("reopen") ("submitter") ("forwarded") + ("notforwarded") ("retitle") ("clone") ("merge") ("unmerge") + ("tags") ("package") ("owner") ("noowner") ("found") + ("notfound") ("fixed") ("notfixed") ("block") ("unblock") ("archive") + ("unarchive") ("affects") ("forcemerge") ("summary")) + "List of available commands at control@bugs.debian.org.") + +(defun debian-bts-bug-number-at-point () + "Read #NNNNNN from current point." + (let ((item (word-at-point))) + (if (and item + (string-match "^[0-9]+[0-9]$" item)) + item))) + +(defun debian-bts-control-prompt (prompt &optional number) + "Prompt for bug number using sensible default if found." + (let ((default-number number)) + (unless default-number + (save-excursion + (goto-char (point-min)) + (if (re-search-forward (concat "\\([0-9]+\\)@" debian-bts-emaildomain) + (mail-header-end) t) + (setq default-number (match-string-no-properties 1))))) + (if default-number + (read-string (format "%s [%s]: " prompt default-number) + nil nil default-number) + (read-string (format "%s: " prompt))))) + +;;;###autoload +(defun debian-bts-control (action &optional arg) + "Contruct a message with initial ACTION command for control@bugs.debian.org. +Contructs a new control command line if called from within the message +being constructed. + +If prefix arg is provided, use the current buffer instead instead of +creating a new outgoing email message buffer. +The current buffer is also used if the current major mode matches one listed +in `debian-bts-control-modes-to-reuse'." + (interactive (list (completing-read "Command: " + debian-bts-control-alist nil nil) + current-prefix-arg)) + (let ((number-default (debian-bts-bug-number-at-point))) + (cond + ((or arg + (and (car (memq t (mapcar '(lambda (item) (eq item major-mode)) + debian-bts-control-modes-to-reuse))) + (not debian-bts-control-minor-mode))) + (debian-bug--set-CC debian-bts-emailaddress + (concat + (symbol-name debian-bts-control-cc-or-bcc) ":")) + (goto-char (point-min)) + (if (re-search-forward (concat "\\([0-9]+\\)@" debian-bts-emaildomain) + (mail-header-end) t) + (setq number-default (match-string 1))) + (goto-char (mail-header-end)) + (forward-line 1) + (if (looking-at "^<#secure") ;Skip over mml directives + (forward-line 1)) + (insert "thanks\n\n") + (debian-bts-control-minor-mode 1)) + ((not debian-bts-control-minor-mode) + (reporter-compose-outgoing) + (if (and (equal mail-user-agent 'gnus-user-agent) + (string-equal " *nntpd*" (buffer-name))) + (set-buffer "*mail*")) ; Bug in emacs21.1? Moves to " *nntpd*" + (goto-char (point-min)) + (cond + ((re-search-forward "To: " nil t) + (insert debian-bts-emailaddress)) + ((re-search-forward "To:" nil t) + (insert " " debian-bts-emailaddress)) + (t + (insert "To: " debian-bts-emailaddress))) + (if debian-bug-use-From-address + (debian-bug--set-custom-From)) + (if debian-bug-always-CC-myself + (debian-bug--set-CC debian-bug-From-address "cc:")) + (goto-char (mail-header-end)) + (forward-line 1) + (if (looking-at "^<#secure") ;Skip over mml directives + (forward-line 1)) + (insert "thanks\n") + (debian-bts-control-minor-mode 1))) + (goto-char (mail-header-end)) + (if (re-search-forward "^thank" nil t) + (beginning-of-line) + (goto-char (point-max))) + (cond + ((string-equal "package" action) + (debian-bug-fill-packages-obarray) + (let* ((verbose (if debian-bts-control-verbose-prompts-flag + "package [ packagename ... ] + + Limits the following commands so that they will only apply to bugs + filed against the listed packages. You can list one or more + packages. If you don't list any packages, the following commands will + apply to all bugs. You're encouraged to use this as a safety feature + in case you accidentally use the wrong bug numbers. + +" + "")) + (package (completing-read + (concat verbose "Package list to limit to: ") + (debian-bug-fill-packages-obarray) nil nil))) + (insert (format "package %s\n" package)))) + ((string-equal "affects" action) + (debian-bug-fill-packages-obarray) + (let* ((verbose (if debian-bts-control-verbose-prompts-flag + "affects bugnumber [ + | - | = ] package [ package ... ] + + Indicates that a bug affects another package. In the case where + bugnumber causes breakage in package even though the bug is + actually present in the package to which it is assigned, this + causes the bug to be listed by default in the bug list of + package. This should generally be used where the bug is severe + enough to cause multiple reports from users to be assigned to + the wrong package. = sets the affects to the list of packages + given, and is the default action if no packages are given; - + removes the given packages from the affects list; + adds the + given packages to the affects list, and is the default if + packages are given. + +" + "")) + (bug-number (debian-bts-control-prompt + (concat verbose "Bug number") + number-default)) + (sign (completing-read + (concat verbose "[ + | - | = ] ") + '(("+") ("-") ("=")) nil nil)) + (package (completing-read + (concat verbose "Package affected: ") + (debian-bug-fill-packages-obarray) nil nil))) + (insert (format "affects %s %s %s \n" bug-number sign package)))) + ((string-equal "reassign" action) + (debian-bug-fill-packages-obarray) + (let* ((verbose (if debian-bts-control-verbose-prompts-flag + "reassign bugnumber package + + Records that bug #BUGNUMBER is a bug in PACKAGE. This can be used to + set the package if the user forgot the pseudo-header, or to change an + earlier assignment. No notifications are sent to anyone (other than the + usual information in the processing transcript). + +" + "Package to reassign to: ")) + (bug-number (debian-bts-control-prompt + (concat verbose "Bug number") + number-default)) + (package (completing-read + (concat verbose "Package to reassign to: ") + (debian-bug-fill-packages-obarray) nil nil))) + (insert (format "reassign %s %s\n" bug-number package)))) + ((string-equal "reopen" action) + (let* ((verbose (if debian-bts-control-verbose-prompts-flag + "reopen bugnumber [ originator-address | = | ! ] + + Reopens #BUGNUMBER if it is closed. + + By default, or if you specify =, the original submitter will remain the + originator of the report. + + The originator will be set to the optional address you supply. If you wish + to become the new originator of the reopened report you can use the ! + shorthand or specify your own email address. + + If the bug is not closed then \"reopen\" won't do anything, not even change + the originator. To change the originator of an open bug report, use the + \"submitter\" command; note that this will inform the original submitter of + the change. + +" + "")) + (bug-number (debian-bts-control-prompt + (concat verbose "Bug number") + number-default)) + (originator (read-string + (concat verbose "Originator-address (optional): ")))) + (insert (format "reopen %s %s\n" bug-number originator)))) + ((string-equal "submitter" action) + (let* ((verbose (if debian-bts-control-verbose-prompts-flag + "submitter bugnumber originator-address | ! + + Changes the originator of #BUGNUMBER to ORIGINATOR-ADDRESS. + + If you wish to become the new originator of the report you can use the + ! shorthand or specify your own email address. + + While the reopen command changes the originator of other bugs merged + with the one being reopened, submitter does not affect merged bugs. + +" + "")) + (bug-number (debian-bts-control-prompt + (concat verbose "Bug number") + number-default)) + (originator (read-string + (concat verbose "Originator-address (optional): ")))) + (insert (format "submitter %s %s\n" bug-number originator)))) + ((string-equal "owner" action) + (let* ((verbose (if debian-bts-control-verbose-prompts-flag + "owner bugnumber address | ! + + Sets address to be the \"owner\" of #bugnumber. The owner of a bug + claims responsibility for fixing it and will receive all mail + regarding it. This is useful to share out work in cases where a + package has a team of maintainers. + + If you wish to become the owner of the bug yourself, you can use the + ! shorthand or specify your own email address. + +" + "")) + (bug-number (debian-bts-control-prompt + (concat verbose "Bug number") + number-default)) + (address (read-string + (concat verbose "address (optional): ")))) + (insert (format "owner %s %s\n" bug-number address)))) + ((string-equal "noowner" action) + (let* ((verbose (if debian-bts-control-verbose-prompts-flag + "noowner bugnumber + + Forgets any idea that the bug has an owner other than the usual + maintainer. If the bug had no owner recorded then this will do + nothing. + +" + "")) + (bug-number (debian-bts-control-prompt + (concat verbose "Bug number") + number-default))) + (insert (format "noowner %s\n" bug-number)))) + ((string-equal "forwarded" action) + (let* ((verbose (if debian-bts-control-verbose-prompts-flag + "forwarded bugnumber address + + Notes that BUGNUMBER has been forwarded to the upstream maintainer at + ADDRESS. This does not actually forward the report. This can be used to + change an existing incorrect forwarded-to address, or to record a new + one for a bug that wasn't previously noted as having been forwarded. + +" + "")) + (bug-number (debian-bts-control-prompt + (concat verbose "Bug number") + number-default)) + (address (read-string + (concat verbose "Forwarded-address: ")))) + (insert (format "forwarded %s %s\n" bug-number address)))) + ((string-equal "notforwarded" action) + (let* ((verbose (if debian-bts-control-verbose-prompts-flag + "notforwarded bugnumber + + Forgets any idea that BUGNUMBER has been forwarded to any upstream + maintainer. If the bug was not recorded as having been forwarded then + this will do nothing. + +" + "")) + (bug-number (debian-bts-control-prompt + (concat verbose "Bug number") + number-default))) + (insert (format "notforwarded %s\n" bug-number)))) + ((string-equal "retitle" action) + (let* ((verbose (if debian-bts-control-verbose-prompts-flag + "retitle bugnumber new-title + + Changes the TITLE of a bug report to that specified (the default is the + Subject mail header from the original report). + + Unlike most of the other bug-manipulation commands, when used on one of + a set of merged reports this will change the title of only the + individual bug requested, and not all those with which it is merged. + +" + "")) + (bug-number (debian-bts-control-prompt + (concat verbose "Bug number") + number-default)) + (title (read-string + (concat verbose "New title: ")))) + (insert (format "retitle %s %s\n" bug-number title)))) + ((string-equal "summary" action) + (let* ((verbose (if debian-bts-control-verbose-prompts-flag + "summary bugnumber [message number | summary text] + + Selects a message to use as a summary of a bug. The first + non-pseudoheader/non-control paragraph of that message is parsed + and set as the summary of the bug which is displayed on the top + of the bug report page. This is useful in cases where the + original report doesn't correctly describe the problem or the + bug has many messages which make it difficult to identify the + actual problem. + + If message number is not given, clears the summary. message + number is the message number as listed in the bugreport cgi + script output; if a message number of 0 is given, the current + message is used (that is, the message which was sent to + control@bugs.debian.org which contains the summary control + command). + + If message number is not numerical and not the empty string, it + is assumed to be the text to set the summary to. + +" + "")) + (bug-number (debian-bts-control-prompt + (concat verbose "Bug number") + number-default)) + (title (read-string + (concat verbose "Summary: ")))) + (insert (format "summary %s %s\n" bug-number title)))) + ((string-equal "severity" action) + (let* ((verbose (if debian-bts-control-verbose-prompts-flag + "severity bugnumber severity + + Set the severity level for bug report #BUGNUMBER to SEVERITY. No + notification is sent to the user who reported the bug. + + Severities are critical, grave, serious, important, normal, minor, and + wishlist. + + For their meanings, consult the Control->Help->Severities menu. + +" + "")) + (bug-number (debian-bts-control-prompt + (concat verbose "Bug number") + number-default)) + (severity (completing-read "Severity: " debian-bug-severity-alist + nil t))) + (insert (format "severity %s %s\n" bug-number severity)))) + ((string-equal "clone" action) + (let* ((verbose (if debian-bts-control-verbose-prompts-flag + "clone bugnumber [ new IDs ] + + Duplicate a bug report. Useful when a single report indicates that + multiple distinct bugs have occured. \"New IDs\" are negative numbers, + separated by spaces, which may be used in subsequent control commands to + refer to the newly duplicated bugs. + Example usage: + clone 12345 -1 -2 + reassign -1 foo + retitle -1 foo: foo sucks + reassign -2 bar + retitle -2 bar: bar sucks when used with foo + severity -2 wishlist +" + "")) + (bug-number (debian-bts-control-prompt + (concat verbose "Bug number") + number-default)) + (ids (read-string (concat verbose "New IDs (e.g. -1 -2): ")))) + (insert (format "clone %s %s\n" bug-number ids)))) + ((string-equal "merge" action) + (let* ((verbose (if debian-bts-control-verbose-prompts-flag + "merge bugnumber bugnumber ... + + Merges two or more bug reports. When reports are merged, opening, closing, + marking or unmarking as forwarded and reassigning any of the bugs to a new + package will have an identical effect on all of the merged reports. + + Before bugs can be merged they must be in exactly the same state. + +" + "")) + (bug-numbers (read-string (concat verbose "All bug numbers: ")))) + (insert (format "merge %s\n" bug-numbers)))) + ((string-equal "forcemerge" action) + (let* ((verbose (if debian-bts-control-verbose-prompts-flag + "forcemerge bugnumber bugnumber ... + + Forcibly merges two or more bug reports. The settings of the + first bug listed which must be equal in a normal merge are + assigned to the bugs listed next. To avoid typos erroneously + merging bugs, bugs must be in the same package. See the text + above for a description of what merging means. + + Note that this makes it possible to close bugs by merging; you + are responsible for notifying submitters with an appropriate + close message if you do this. + +" + "")) + (bug-numbers (read-string (concat verbose "All bug numbers: ")))) + (insert (format "forcemerge %s\n" bug-numbers)))) + ((string-equal "unmerge" action) + (let* ((verbose (if debian-bts-control-verbose-prompts-flag + "unmerge bugnumber + + Disconnects a bug report from any other reports with which it may have + been merged. If the report listed is merged with several others then + they are all left merged with each other; only their associations with + the bug explicitly named are removed. + +" + "")) + (bug-number (debian-bts-control-prompt + (concat verbose "Bug number") + number-default))) + (insert (format "unmerge %s\n" bug-number)))) + ((string-equal "tags" action) + (let* ((verbose (if debian-bts-control-verbose-prompts-flag + "tags bugnumber [ + | - | = ] tag + + Sets a particular tag for the bug report #BUGNUMBER to tag. No + notification is sent to the user who reported the bug. + means adding, - + means subtracting, and = means ignoring the current tags and setting them + afresh. The default action is adding. + + Tags are patch, wontfix, moreinfo, unreproducible, help, pending, fixed, + fixed-in-experimental, fixed-upstream, security, upstream, confirmed, d-i, + ipv6, lfs, l10n, potato, woody, sarge, sarge-ignore, etch, etch-ignore, + sid, and experimental. + + For their meanings, consult the Control->Help->Tags menu. + +" + "")) + (bug-number (debian-bts-control-prompt + (concat verbose "Bug number") + number-default)) + (add (completing-read "+, -, = (default +): " + '(("+") ("-") ("=")) nil t nil nil "+")) + (tag (completing-read "Tag: " debian-bug-alltags-alist nil t))) + (insert (format "tags %s %s %s\n" bug-number add tag)))) + ((string-equal "close" action) + (if (yes-or-no-p + (concat "Deprecated in favor of #BUG-close@" + debian-bts-emaildomain ". Continue? ")) + (let* ((verbose (if debian-bts-control-verbose-prompts-flag + "close bugnumber + + Close bug report #BUGNUMBER. + + A notification is sent to the user who reported the bug, but (in contrast + to mailing bugnumber-done@bugs) the text of the mail which caused the bug + to be closed is not included in that notification. The maintainer who + closes a report needs to ensure, probably by sending a separate message, + that the user who reported the bug knows why it is being closed. The use of + this command is therefore deprecated. + +" + "")) + (bug-number (debian-bts-control-prompt + (concat verbose "Bug number") + number-default))) + (insert (format "close %s\n" bug-number))))) + ((string-equal "found" action) + (let* ((verbose (if debian-bts-control-verbose-prompts-flag + "found bugnumber [version] + + Record that #bugnumber has been encountered in the given + version of the package to which it is assigned. + + The BTS considers a bug to be open when it has no fixed + version, or when it has been found more recently than it has + been fixed. + + If no version is given, then the list of fixed versions for + the bug is cleared. This is identical to the behaviour of + reopen. + + This command will only cause a bug to be marked as not done + if no version is specified, or if the version being marked + found is equal to the version which was last marked + fixed. (If you are certain that you want the bug marked as + not done, use reopen in conjunction with found.) + +" + "")) + (bug-number (debian-bts-control-prompt + (concat verbose "Bug number") + number-default)) + (version (read-string (concat verbose "Version (if any): ")))) + (insert (format "found %s %s\n" bug-number version)))) + ((string-equal "notfound" action) + (let* ((verbose (if debian-bts-control-verbose-prompts-flag + "notfound bugnumber version + + Remove the record that #bugnumber was encountered in the + given version of the package to which it is assigned. + + This differs from closing the bug at that version in that the + bug is not listed as fixed in that version either; no + information about that version will be known. It is intended + for fixing mistakes in the record of when a bug was found. + +" + "")) + (bug-number (debian-bts-control-prompt + (concat verbose "Bug number") + number-default)) + (version (read-string (concat verbose "Version: ")))) + (insert (format "notfound %s %s\n" bug-number version)))) + ((string-equal "fixed" action) + (let* ((verbose (if debian-bts-control-verbose-prompts-flag + "fixed bugnumber version + + Indicate that bug #bugnumber was fixed in the given version + of the package to which it is assigned. + + This does not cause the bug to be marked as closed, it merely + adds another version in which the bug was fixed. Use the + bugnumber-done address to close a bug and mark it fixed in a + particular version. + +" + "")) + (bug-number (debian-bts-control-prompt + (concat verbose "Bug number") + number-default)) + (version (read-string (concat verbose "Version: ")))) + (insert (format "fixed %s %s\n" bug-number version)))) + ((string-equal "notfixed" action) + (let* ((verbose (if debian-bts-control-verbose-prompts-flag + "notfixed bugnumber version + + Remove the record that bug #bugnumber has been fixed in the + given version. + + This command is equivalent to found followed by notfound (the + found removes the fixed at a particular version, and notfound + removes the found.) + +" + "")) + (bug-number (debian-bts-control-prompt + (concat verbose "Bug number") + number-default)) + (version (read-string (concat verbose "Version: ")))) + (insert (format "notfixed %s %s\n" bug-number version)))) + ((string-equal "block" action) + (let* ((verbose (if debian-bts-control-verbose-prompts-flag + "block bugnumber by bug ... + + Note that the fix for the first bug is blocked by the other + listed bugs. + +" + "")) + (bug-number (debian-bts-control-prompt + (concat verbose "Bug number") + number-default)) + (by-bug (read-string (concat verbose "by bug number(s): ")))) + (insert (format "block %s by %s\n" bug-number by-bug)))) + ((string-equal "unblock" action) + (let* ((verbose (if debian-bts-control-verbose-prompts-flag + "nblock bugnumber by bug ... + Note that the fix for the first bug is no longer blocked by the other listed bugs. + +" + "")) + (bug-number (debian-bts-control-prompt + (concat verbose "Bug number") + number-default)) + (by-bug (read-string (concat verbose "by bug number(s): ")))) + (insert (format "unblock %s by %s\n" bug-number by-bug)))) + ((string-equal "archive" action) + (let* ((verbose (if debian-bts-control-verbose-prompts-flag + "archive bugnumber + + Archives a bug that had been archived at some point in the + past but is currently not archived if the bug fulfills the + requirements for archival, ignoring time. + +" + "")) + (bug-number (debian-bts-control-prompt + (concat verbose "Bug number") + number-default))) + (insert (format "archive %s\n" bug-number)))) + ((string-equal "unarchive" action) + (let* ((verbose (if debian-bts-control-verbose-prompts-flag + "unarchive bugnumber + + Unarchives a bug that was previously archived. Unarchival + should generally be coupled with reopen and found/fixed as + appropriate. Bugs that have been unarchived can be archived + using archive assuming the non-time based archival + requirements are met. + +" + "")) + (bug-number (debian-bts-control-prompt + (concat verbose "Bug number") + number-default))) + (insert (format "unarchive %s\n" bug-number)))) + ))) + + +(defun debian-bts-help-control () + (with-output-to-temp-buffer "*Help*" + (princ + "reassign bugnumber package + + Records that bug #bugnumber is a bug in package. This can be used to + set the package if the user forgot the pseudo-header, or to change an + earlier assignment. No notifications are sent to anyone (other than the + usual information in the processing transcript). + +reopen bugnumber [ originator-address | = | ! ] + + Reopens #bugnumber if it is closed. + + By default, or if you specify =, the original submitter is still as the + originator of the report, so that they will get the ack when it is + closed again. + + If you supply an originator-address the originator will be set to the + address you supply. If you wish to become the new originator of the + reopened report you can use the ! shorthand or specify your own email + address. + + It is usually a good idea to tell the person who is about to be + recorded as the originator that you're reopening the report, so that + they will know to expect the ack which they'll get when it is closed + again. + + If the bug is not closed then reopen won't do anything, not even change + the originator. To change the originator of an open bug report, use the + submitter command; note that this will inform the original submitter of + the change. + +found bugnumber [ version ] + + Record that #bugnumber has been encountered in the given + version of the package to which it is assigned. + + The bug tracking system uses this information, in conjunction + with fixed versions recorded when closing bugs, to display + lists of bugs open in various versions of each package. It + considers a bug to be open when it has no fixed version, or + when it has been found more recently than it has been fixed. + + If no version is given, then the list of fixed versions for + the bug is cleared. This is identical to the behaviour of + reopen. + + This command will only cause a bug to be marked as not done + if no version is specified, or if the version being marked + found is equal to the version which was last marked + fixed. (If you are certain that you want the bug marked as + not done, use reopen in conjunction with found.) + + This command was introduced in preference to reopen because + it was difficult to add a version to that command's syntax + without suffering ambiguity. + +notfound bugnumber version + + Remove the record that #bugnumber was encountered in the + given version of the package to which it is assigned. + + This differs from closing the bug at that version in that the + bug is not listed as fixed in that version either; no + information about that version will be known. It is intended + for fixing mistakes in the record of when a bug was found. + +fixed bugnumber version + + Indicate that bug #bugnumber was fixed in the given version + of the package to which it is assigned. + + This does not cause the bug to be marked as closed, it merely + adds another version in which the bug was fixed. Use the + bugnumber-done address to close a bug and mark it fixed in a + particular version. + +notfixed bugnumber version + + Remove the record that bug #bugnumber has been fixed in the given version. + + This command is equivalent to found followed by notfound (the found removes the fixed at a particular version, and notfound removes the found.) + +submitter bugnumber originator-address | ! + + Changes the originator of #bugnumber to originator-address. + + If you wish to become the new originator of the report you can use the + ! shorthand or specify your own email address. + + While the reopen command changes the originator of other bugs merged + with the one being reopened, submitter does not affect merged bugs. + +forwarded bugnumber address + + Notes that bugnumber has been forwarded to the upstream maintainer at + address. This does not actually forward the report. This can be used to + change an existing incorrect forwarded-to address, or to record a new + one for a bug that wasn't previously noted as having been forwarded. + +notforwarded bugnumber + + Forgets any idea that bugnumber has been forwarded to any upstream + maintainer. If the bug was not recorded as having been forwarded then + this will do nothing. + +retitle bugnumber new-title + + Changes the title of a bug report to that specified (the default is the + Subject mail header from the original report. + + Unlike most of the other bug-manipulation commands when used on one of + a set of merged reports this will change the title of only the + individual bug requested, and not all those with which it is merged. + +severity bugnumber severity + + Set the severity level for bug report #bugnumber to severity. No + notification is sent to the user who reported the bug. + + Severities are critical, grave, serious, important, normal, minor, and + wishlist. + + For their meanings please consult the general developers' documentation + for the bug system. + +clone bugnumber [ new IDs ] + + The clone control command allows you to duplicate a bug report. It is + useful in the case where a single report actually indicates that + multiple distinct bugs have occured. \"New IDs\" are negative numbers, + separated by spaces, which may be used in subsequent control commands + to refer to the newly duplicated bugs. A new report is generated for + each new ID. + + Example usage: + + clone 12345 -1 -2 + reassign -1 foo + retitle -1 foo: foo sucks + reassign -2 bar + retitle -2 bar: bar sucks when used with foo + severity -2 wishlist + clone 123456 -2 + reassign -2 foo + retitle -2 foo: foo sucks + merge -1 -2 + + +merge bugnumber bugnumber ... + + Merges two or more bug reports. When reports are merged, opening, + closing, marking or unmarking as forwarded and reassigning any of the + bugs to a new package will have an identical effect on all of the + merged reports. + + Before bugs can be merged they must be in exactly the same state: + either all open or all closed, with the same forwarded-to upstream + author address or all not marked as forwarded, all assigned to the same + package or package(s) (an exact string comparison is done on the + package to which the bug is assigned), and all of the same severity. If + they don't start out in the same state you should use reassign, reopen + and so forth to make sure that they are before using merge. + + If any of the bugs listed in a merge command is already merged with + another bug then all the reports merged with any of the ones listed + will all be merged together. Merger is like equality: it is reflexive, + transitive and symmetric. + + Merging reports causes a note to appear on each report's logs; on the + WWW pages this is includes links to the other bugs. + + Merged reports are all expired simultaneously, and only when all of the + reports each separately meet the criteria for expiry. + +unmerge bugnumber + + Disconnects a bug report from any other reports with which it may have + been merged. If the report listed is merged with several others then + they are all left merged with each other; only their associations with + the bug explicitly named are removed. + + If many bug reports are merged and you wish to split them into two + separate groups of merged reports you must unmerge each report in one + of the new groups separately and then merge them into the required new + group. + + You can only unmerge one report with each unmerge command; if you want + to disconnect more than one bug simply include several unmerge commands + in your message. + +tags bugnumber [ + | - | = ] tag + + Sets a particular tag for the bug report #bugnumber to tag. No + notification is sent to the user who reported the bug. + means adding, + - means subtracting, and = means ignoring the current tags and setting + them afresh. The default action is adding. + + Available tags currently include patch, wontfix, moreinfo, + unreproducible, help, pending, fixed, security, upstream, fixed-upstream, + potato, woody, sarge, sarge-ignore, sid and experimental. + + For their meanings, consult the Control->Help->Tags menu. + +block bugnumber by bug ... + + Note that the fix for the first bug is blocked by the other + listed bugs. + +unblock bugnumber by bug ... + + Note that the fix for the first bug is no longer blocked by + the other listed bugs. + +close bugnumber + + Close bug report #bugnumber. + + A notification is sent to the user who reported the bug, but (in + contrast to mailing bugnumber-done@bugs) the text of the mail which + caused the bug to be closed is not included in that notification. The + maintainer who closes a report needs to ensure, probably by sending a + separate message, that the user who reported the bug knows why it is + being closed. The use of this command is therefore deprecated. + +package [ packagename ... ] + + Limits the following commands so that they will only apply to bugs + filed against the listed packages. You can list one or more packages. If + you don't list any packages, the following commands will apply to all + bugs. You're encouraged to use this as a safety feature in case you + accidentally use the wrong bug numbers. + + Example usage: + + package foo + reassign 123456 bar + + package bar + retitle 123456 bar: bar sucks + severity 123456 normal + + package + severity 234567 wishlist + +owner bugnumber address | ! + + Sets address to be the \"owner\" of #bugnumber. The owner of a bug + claims responsibility for fixing it and will receive all mail + regarding it. This is useful to share out work in cases where a + package has a team of maintainers. + + If you wish to become the owner of the bug yourself, you can use + the ! shorthand or specify your own email address. + +noowner bugnumber + + Forgets any idea that the bug has an owner other than the usual + maintainer. If the bug had no owner recorded then this will do + nothing. + +archive bugnumber + + Archives a bug that had been archived at some point in the + past but is currently not archived if the bug fulfills the + requirements for archival, ignoring time. + +unarchive bugnumber + + Unarchives a bug that was previously archived. Unarchival + should generally be coupled with reopen and found/fixed as + appropriate. Bugs that have been unarchived can be archived + using archive assuming the non-time based archival + requirements are met. + +quit +stop +thank... +--... + + Tells the control server to stop processing the message; the remainder + of the message can include explanations, signatures or anything else, + none of it will be detected by the control server. + +#... + + One-line comment. The # must be at the start of the line. + +Help text from http://www.debian.org/Bugs/server-control, Apr 22nd 2003. +Copyright 1999 Darren O. Benham, 1994-1997 Ian Jackson, + 1997 nCipher Corporation Ltd."))) + +;;;###autoload +(defun emacs-bts-control (action &optional arg) + "Contruct a message with ACTION command for control@debbugs.gnu.org. +Contructs a new control command line if called from within the message +being constructed. + +If prefix arg is provided, use the current buffer instead instead of +creating a new outgoing email message buffer. +The current buffer is also used if the current major mode matches one listed +in `debian-bts-control-modes-to-reuse'." + (interactive (list (completing-read "Command: " + debian-bts-control-alist nil nil) + current-prefix-arg)) + (let ((debian-bts-emailaddress "control@debbugs.gnu.org") + (debian-bts-emaildomain "debbugs.gnu.org") + (debian-bts-control-for-emacs t)) + (debian-bts-control action arg))) + +(provide 'debian-bts-control) + +;;; debian-bts-control.el ends here diff --git a/elisp/dpkg-dev-el/debian-changelog-mode.el b/elisp/dpkg-dev-el/debian-changelog-mode.el new file mode 100755 index 0000000..4d51654 --- /dev/null +++ b/elisp/dpkg-dev-el/debian-changelog-mode.el @@ -0,0 +1,1814 @@ +;;; debian-changelog-mode.el --- major mode for Debian changelog files. + +;; Copyright (C) 1996 Ian Jackson +;; Copyright (C) 1997 Klee Dienes +;; Copyright (C) 1999 Chris Waters +;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005 Peter S Galbraith +;; Copyright (C) 2006, 2007, 2009, 2010 Peter S Galbraith +;; +;; 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. +;; +;; debian-changelog-mode.el 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 your Debian installation, in /usr/share/common-licenses/GPL +;; If not, write to the Free Software Foundation, 51 Franklin Street, +;; Suite 500 Boston, MA 02110-1335, USA + +;;; Commentary: +;; +;; This is a major mode for Debian changelog files. The main features +;; are: +;; +;; - fontification (varies with upload urgency, etc). +;; - create a entry for a new version (guessing the version number). +;; - finalize a version with proper timestamp and syntax. +;; - add an entry from another file in the source package. +;; - interface with `debian-bug' to fetch list of bugs from the web, +;; read a bug report via browse-url or as email, close a bug with +;; thanks. +;; - closed bugs are fontified and clickable to view them via browse-url. +;; +;; The mode is entered automatically when editing a debian/changelog file. +;; See the menus "Bugs" and "Changelog" for commands or do `C-h m' to get +;; the list of keybindings. +;; +;; From other files in unpacked sources, do `M-x debian-changelog-add-entry' +;; to add an entry for that file in the changelog file. + +;;; History +;; +;; V1.00 30aug00 Peter S Galbraith +;; - Prior version had no changelogs; starting one now. +;; This is the potato version plus extensions by Chris Waters (easymenu; +;; better menus, font-lock support). +;; V1.01 30aug00 Peter S Galbraith +;; - debian-changelog-finalise-last-version: Use XEmacs' (user-mail-address) +;; function if variable user-mail-address is undefined. +;; Thanks to Robert Bihlmeyer , closes Bug#61524 +;; - debian-changelog-finalise-last-version: Takes account of some env vars +;; Thanks to Rafael Laboissiere , closes Bug#61226 +;; - debian-changelog-close-bug: new command. +;; V1.02 23Feb01 Peter S Galbraith +;; - Added `debian-changelog-suggest-version', a mechanisn for guessing +;; what the new version number should be. +;; Closes half of Bug#85412 +;; V1.03 23Feb01 Peter S Galbraith +;; - Fixed `fill-paragraph' by tweaks to paragraph-start and +;; paragraph-separate variables. +;; Closes second half of Bug#85412 +;; V1.04 23Feb01 Peter S Galbraith +;; - Added `debian-changelog-web-bugs' `debian-changelog-web-packages' +;; `debian-changelog-web-package' +;; V1.05 23Feb01 Peter S Galbraith +;; - made `debian-changelog-suggest-package-name' more picky about finding +;; an acceptable name. +;; V1.06 28Feb01 Peter S Galbraith +;; - Create customizable variables debian-changelog-full-name and +;; debian-changelog-mailing-address. +;; - Make debian-changelog-finalise-last-version use them. +;; V1.07 28Feb01 Peter S Galbraith +;; - debian-changelog-suggest-version: Handle epochs! +;; closes: Bug#87964: dpkg-dev-el: does wrong things with epochs +;; V1.08 07Mar01 Peter S Galbraith +;; debian-changelog-suggest-version: Handle package names with hyphens! +;; closes: #88589 and #88245 +;; V1.09 09Mar01 Peter S Galbraith +;; debian-changelog-suggest-version: better regexps for version numbers +;; Created debian-changelog-increment-version +;; V1.10 10Mar01 Peter S Galbraith +;; tweaks docs for debian-changelog-mode function concerning +;; add-log-mailing-address (now obsolete). +;; V1.11 24Apr01 Peter S Galbraith +;; Add stuff to try to trim out obsolete "Local Variables:" block from +;; changelog files. +;; V1.12 24Apr01 Peter S Galbraith +;; Modify font-lock code. closes: #93243 +;; V1.13 27Apr01 Peter S Galbraith +;; Move code concerning local variables near beginning of file such that +;; `hack-local-variables' doesn't complain. +;; V1.14 30Apr01 Peter S Galbraith +;; Add `critical' bug severity (see http://bugs.debian.org/94475) +;; V1.15 30Apr01 Peter S Galbraith +;; Tweak font-locking bug number regexp to match dpkg-parsechangelog 1.9.1 +;; V1.16 30Apr01 Peter S Galbraith +;; Added debian-changelog-web-bug (will bound to a mouse button later) +;; V1.17 30Apr01 Peter S Galbraith +;; debian-changelog-increment-version: Handle 3.5.4.0 case (single digits) +;; closes: #95831 +;; V1.18 30Apr01 Peter S Galbraith +;; Add mouse interface to web-bug (with green highlight). +;; V1.19 01May01 Peter S Galbraith +;; Add imenu support as `History'. Bug: The history menu is empty when +;; point is on the (mouse-highlighted) bug number (using emacs-20.7). +;; V1.20 02May01 Peter S Galbraith +;; Leave `mode: debian-changelog-mode' alone for native packages. +;; V1.21 02May01 Peter S Galbraith +;; Fix empty History menu when on bug numbers. +;; V1.22 02May01 Peter S Galbraith +;; Fontify version number (e.g. NMU in warning-face) +;; V1.23 02May01 Peter S Galbraith +;; Bypass imenu-progress-message because it breaks byte-compilation (?) +;; V1.24 03May01 Peter S Galbraith +;; Correct fix for imenu-progress-message macro (can't rely on variable +;; defined here for loading of imenu during byte-compilation). +;; V1.25 04May01 Peter S Galbraith +;; Add `experimental' distribution. +;; V1.26 04May01 Peter S Galbraith +;; Web site changed the URL for package searches: +;; http://cgi.debian.org/cgi-bin -> http://packages.debian.org/cgi-bin +;; V1.27 04May01 Peter S Galbraith +;; Set new version to `experimental' when last one was set to that. +;; closes: #96260: Default to the same distribution as the previous release +;; V1.28 04May01 Peter S Galbraith +;; Make `set-distribution' and `set-urgency' unavailable when changelog +;; is finalised (error at command line and menu grayed-out). +;; V1.29 04May01 Peter S Galbraith +;; Add-to auto-mode-alist in case not using dpkg-dev-el package. +;; V1.30 09May01 Peter S Galbraith +;; Fixed brain-damaged auto-mode-alist added in V1.29 (*blush*). +;; V1.31 28May01 Peter S Galbraith +;; Fix typo (closes: #98577). +;; Add a message display after each call to browse-url. +;; V1.32 28May01 Peter S Galbraith +;; - XEmacs21's easy-menu-define doesn't like :active. +;; - XEmacs21 need easy-menu-add call in mode setup. +;; - debian-changelog-setheadervalue: check at this lower level if finalised. +;; V1.33 29May01 Peter S Galbraith +;; Fix History IMenu for XEmacs21 (it doesn't autoload +;; match-string-no-properties). +;; V1.34 29May01 Peter S Galbraith +;; - debian-changelog-fontify-version: allow version numbers with many hyphens +;; - debian-changelog-suggest-version: heavy changes to deal with many hyphens +;; V1.35 06Jun01 Peter S Galbraith +;; - patch from Brian Warner to make +;; debian-changelog-local-variables-maybe-remove-done really buffer-local. +;; - Change another occurrence of make-local-variable. +;; V1.36 11Jun01 Peter S Galbraith +;; changed urgency "critical" to "emergency". +;; See http://lists.debian.org/debian-policy-0106/msg00095.html +;; V1.37 11Jun01 Peter S Galbraith +;; debian-changelog-suggest-version: another tweak when upstream version +;; number contains hyphens (closes: #100162). +;; V1.38 13Jun01 Peter S Galbraith +;; debian-changelog-suggest-version: peppered regexp-quote at various places +;; to match package names and version that contain regexp characters. +;; V1.39 13Jun01 Peter S Galbraith +;; change (provide 'debian-changelog) to (provide 'debian-changelog-mode) +;; (closes: #100639) Thanks *again* Yann Dirson! +;; V1.40 22Jun01 Peter S Galbraith +;; Changed urgency "emergency" back to "critical" (!) +;; See http://lists.debian.org/debian-policy-0106/msg00240.html +;; V1.41 04Jul01 Peter S Galbraith +;; debian-changelog-finalised-p updated by Tommi Virtanen +;; (closes: #102088) +;; V1.42 10Jul01 Peter S Galbraith +;; debian-changelog-finalised-p: tweak regexp (really closes: #102088) +;; V1.43 25Jul01 Peter S Galbraith +;; font-lock enforces 2 space exactly between email and date. +;; V1.44 26Jul01 Peter S Galbraith +;; No conditions left to keep variable block (See bug #105889) +;; - Removed debian-changelog-package-native-p function. +;; - Removed debian-changelog-local-variables-email-p function. +;; - Removed debian-changelog-local-variables-remove-address function. +;; - Removed debian-changelog-local-variables-remove-mode function. +;; - Created debian-changelog-local-variables-remove function. +;; V1.45 15Aug01 Peter S Galbraith +;; Bug list menu added (via wget). +;; V1.46 15Aug01 Roland Mas +;; One-character tweak to package name font-lock regexp. +;; V1.47 15Aug01 Peter S Galbraith +;; debian-changelog-web-bug: bug fix when called from menu +;; V1.48 19Sep01 Brian Warner +;; - move to end of file before prompting for removal of local variables. +;; - remove global def of debian-changelog-local-variables-maybe-remove-done. +;; V1.49 22Nov01 Roland Mas +;; debian-changelog-suggest-version: tweak regexp for case of upstream +;; version number with a single character. +;; V1.50 30Nov01 Roland Mas +;; replaced debian-changelog.el by debian-changelog-mode.el +;; V1.51 24Jan02 Peter S Galbraith +;; debian-changelog-web-bugs: return all bugs for the source package. +;; V1.52 07Feb02 Peter S Galbraith +;; debian-changelog-build-bug-menu: return all bugs for the source package. +;; V1.53 13May02 Peter S Galbraith +;; debian-changelog-mode: Add call to hack-local-variables since the "Local +;; variables:" block wasn't parsed otherwise. Strange. +;; V1.54 29May02 Peter S Galbraith +;; s/font-latex-warning-face/debian-changelog-warning-face/ +;; Now that was a weird leftover from cut/paste! +;; V1.55 03June02 Peter S Galbraith +;; fontify woody-proposed-updates as frozen. +;; V1.56 25July02 Peter S Galbraith +;; debian-changelog-mode: Remove call to hack-local-variables added in V1.53 +;; since a "mode: debian-changelog" setting created an infinite loop. +;; The bug I attemped to fix in V1.53 occurred when debian-changelog-mode +;; was invoked using the debian-changelog-find-file-hook mecanism in +;; 50dpkg-dev-el.el. This invoked debian-changelog-mode which called +;; kill-all-local-variables, deleting our settings. To get around this, I +;; no longer call 'text-mode' and copied whatever setting we need from it +;; (because it also kill-all-local-variables). +;; closes: #153982. +;; V1.57 29July02 Peter S Galbraith +;; debian-changelog-mode: Reinsert kill-all-local-variables removed in +;; last version. It's used by font-lock-mode to turn on font-lock-mode +;; when global-font-lock-mode is used. Since this kills the Local +;; Variables, the mode can no longer be entered late in the game as was +;; done in 50dpkg-dev-el.el by a find-file-hooks. Instead, use a +;; change-log-mode-hook which is less intrusive anyway. +;; V1.58 29July02 Peter S Galbraith +;; debian-changelog-greater-than: new function to determine if a version +;; number is greater than another. Used it to incorporate some logic +;; for for better guessing of new version numbers for native packages to +;; fix bug #113964. +;; V1.59 02Aug2002 Peter S Galbraith +;; Remove a bunch of code duplicated in debian-bug.el and load that file +;; instead. +;; debian-changelog-web-bugs -> debian-bug-web-bugs +;; debian-changelog-web-bug -> debian-bug-web-bug +;; debian-changelog-web-packages -> debian-bug-web-packages +;; debian-changelog-web-package -> debian-bug-web-package +;; dpkg-dev-el package should depend on versioned debbugs-el. +;; V1.60 15Aug2002 Peter S Galbraith +;; Update list of possible distributions to upload to from list given +;; from http://bugs.debian.org/150466 (Closes: #156762) +;; V1.61 20Aug2002 Peter S Galbraith +;; Prompt for confirmation and give *big* warning if user wants to set +;; the upload distribution to a -security one. See discussion on +;; http://bugs.debian.org/150466 +;; V1.62 20Aug2002 Peter S Galbraith +;; V1.63 05Sep2002 Peter S Galbraith +;; Fontify bugs on multiple-line closes: statements. Patch from +;; Frdric Bothamy. (Closes: #159041) +;; V1.64 05Sep2002 Peter S Galbraith +;; debian-changelog-suggest-version fix (Closes: #159643) +;; V1.65 05Sep2002 Peter S Galbraith +;; - Stupid bug fix. s/debian-bug-bug-alist/debian-bug-alist/. +;; - Bug closing regexp enhancement from Roland Mas. +;; V1.66 24Oct2002 Peter S Galbraith +;; - Add UNRELEASED distribution, patch from Junichi Uekawa +;; with additional menu entry (Closes: #166163). +;; See bug #164470 for relevance and usage of UNRELEASED distribution. +;; V1.67 14Apr2003 Peter S Galbraith +;; - Use debian-bug.el's debian-bug-open-alist (needs emacs-goodies-el 19.4) +;; V1.68 21Apr2003 Peter S Galbraith +;; Byte-compilation cleanup. +;; V1.69 27Apr2003 Peter S Galbraith +;; - defcustom debian-changelog-mode-hook added. (Closes: #190853) +;; - debian-changelog-add-version creates new version in empty file +;; (Closes: #191285) +;; V1.70 28May2003 Peter S Galbraith +;; - Define (really) match-string-no-properties for XEmacs (Closes: #195181) +;; V1.71 02Sep2003 Peter S Galbraith +;; - When closing a bug, insert bug title and thanks if bug info was +;; downloaded from the web. +;; V1.72 17Sep2003 Peter S Galbraith +;; - Added browse-url link to `Best Practices for debian/changelog' in menu. +;; V1.73 04Nov2003 Peter S Galbraith +;; - checkdoc fixed (not complete!) +;; - Add autoload tag. +;; V1.74 22Nov2003 Peter S Galbraith +;; - Make `debian-changelog-add-entry' works from files in unpacked sources. +;; Thanks to Junichi Uekawa for suggesting it (Closes: #220641) +;; V1.75 27Nov2003 Peter S Galbraith +;; - Add menu entry for "Archived Bugs for This Package", for +;; "Developer Page for This Package" and +;; "Developer Page for This Maintainer". +;; - Added function `debian-changelog-maintainer' and interactive command +;; `debian-changelog-web-developer-page'. +;; V1.76 17Dec2003 Peter S Galbraith +;; - debian-changelog-setdistribution: Use `should-use-dialog-box-p' on XEmacs +;; (Closes: #224187) +;; V1.77 19Feb2004 Peter S Galbraith +;; - Add file NEWS.Debian to auto-mode-alist. Thanks to Chris Lawrence +;; for suggesting it. (Closes: #233310) +;; V1.78 14Apr2004 Peter S Galbraith +;; - debian-changelog-setdistribution: Dismiss warning window when setting +;; distribution to security. Thanks to Martin Schulze (Closes: #234730) +;; - Should mark line beginning with a tab as invalid. Fontified in warning +;; face. Thanks to Michel Daenzer (Closes: #235310). +;; V1.79 07June2005 Jari Aalto +;; - fix byte-compilation warning about +;; `(fboundp (quote imenu))' called for effect (Closes: #309788) +;; V1.80 15Sep2005 Rafael Laboissiere +;; - Add debian-changelog-add-version-hook defaulting to +;; debian-changelog-add-new-upstream-release (Closes: #296725) +;; V1.81 19Sep2005 Peter S Galbraith +;; - Add outline-regexp and C-cC-n and C-cC-p movement commands as +;; suggested by Romain Francoise (Closes: #322994) +;; V1.82 05Sep2006 Peter Samuelson +;; - Add tilde support for upstream version numbers (Closes: #382514) +;; V1.83 11Oct2006 Luca Capello +;; - Rename `debian-changelog-maintainer' to `debian-changelog-last-maintainer', +;; this is what the function really work on +;; - `debian-changelog-last-maintainer' now returns a list of "(NAME EMAIL)" +;; and not only EMAIL +;; - Add `debian-changelog-comaintainer-insert', which actually inserts the +;; co-maintainer name in the form "[ NAME ]" +;; - Add `debian-changelog-comaintainer', which checks if we're in a +;; co-maintenance, calling `debian-changelog-comaintainer-insert' +;; - Add co-maintenance support to `debian-changelog-unfinalise-last-version' +;; V1.84 14May2007 Peter S Galbraith +;; - Use "date -R" instead of deprecated "822-date" +;; (Closes: #423142, #423155, #423828) +;; - Tighter regexp for finalisation string +;; V1.85 25Jul2007 Peter S Galbraith +;; - Adapt patch from Luca Capello for bug #431091 +;; V1.86 08Aug2007 Peter S Galbraith +;; - auto-mode-alist for "/debian/*NEWS" files (Closes: #424779) +;; V1.87 02Sep2007 Peter S Galbraith +;; - Implement pacakge lookup on http://packages.debian.org/ +;; See http://bugs.debian.org/87725 +;; - Patch from Luca Capello to add keys to generate the +;; open bug alist. +;; V1.88 12Apr2008 Trent W. Buck +;; - Generalize auto-mode-alist entry. +;; See http://bugs.debian.org/457047 +;; V1.89 23Feb2009 Jari.aalto@cante.net +;; - finalize date in UTC (User configurable) (Closes: #503700) +;; V1.90 24Oct2009 Rafael Laboissiere +;; - debian-changelog-close-bug does not work properly under XEmacs 21.4.21 +;; because the arguments passed to replace-in-string in the inline function +;; debian-chagelog--rris are in the wrong order. Closes: #476271 +;; V1.91 12Nov2009 Peter S Galbraith +;; Updated URL for "Best practices". +;; V1.92 27Apr2010 Peter S Galbraith +;; Invoke `debian-bug-build-bug-menu' with SOURCE arg set to t. +;; Needs debian-el 33.2 +;; V1.93 10May2010 Peter S Galbraith +;; Fix typo (Closes: #580818) +;; V1.94 28Jul2010 Kevin Ryde +;; Simplify auto-mode-alist (Closes: #587924) +;; V1.95 01Dec2013 Matt Kraai +;; Change the default urgency to medium (Closes: #731105) +;; V1.96 06Nov2016 Guido Gnther +;; Bug fix: "improve handling of {old-, }stable-proposed-updates", thanks +;; to Guido Gunther (Closes: #818010). +;; V1.97 06Nov2016 Pierre Carrier (on 2013-07-04) +;; https://bugs.launchpad.net/ubuntu/+source/emacs-goodies-el/+bug/1197870 +;; Bug fix #803767 debian-changelog-mode: don't rely on external date +;; See also https://github.com/pcarrier/debian-changelog-mode/commit/285d4cc938468fd3d7d74584da7981705727fbab +;; V1.98 06Nov2016 Kumar Appaiah +;; highlight backports (Closes: #708317) + +;;; Acknowledgements: (These people have contributed) +;; Roland Rosenfeld +;; James LewisMoss +;; Rafael Laboissiere +;; Brian Warner +;; Yann Dirson + +;;; Code: + +(defgroup debian-changelog nil "Debian changelog maintenance" + :group 'tools + :prefix "debian-changelog-") + +(defgroup debian-changelog-faces nil + "Faces for fontifying text in debian-changelog." + :prefix "debian-changelog-" + :group 'debian-changelog) + +(defcustom debian-changelog-full-name (or (getenv "DEBFULLNAME") + (user-full-name)) + "*Full name of user, for inclusion in Debian changelog headers. +This defaults to the contents of environment variable DEBFULLNAME +or else to the value returned by the function `user-full-name'." + :group 'debian-changelog + :type 'string) + +(defcustom debian-changelog-mailing-address + (or (getenv "DEBEMAIL") + (getenv "EMAIL") + (and (boundp 'user-mail-address) user-mail-address) + (and (fboundp 'user-mail-address) (user-mail-address))) + "*Electronic mail address of user, for inclusion in Debian changelog headers. +This defaults to the value of (in order of precedence): + Contents of environment variable DEBEMAIL, + Contents of environment variable EMAIL, + Value of `user-mail-address' variable, + Value returned by the `user-mail-address' function." + :group 'debian-changelog + :type 'string) + +(defcustom debian-changelog-allowed-distributions + '("unstable" + "testing" + "testing-security" + "stable" + "stable-security" + "stable-proposed-updates" + "oldstable-security" + "oldstable-proposed-updates" + "experimental" + "UNRELEASED" ) + "*Allowed values for distribution." + :group 'debian-changelog + :type '(repeat string)) + +(defcustom debian-changelog-local-variables-maybe-remove t + "*Ask to remove obsolete \"Local Variables:\" block from changelog. +This is done only under certain conditions." + :group 'debian-changelog + :type 'boolean) + +(defcustom debian-changelog-highlight-mouse-t t + "*Use special overlay for bug numbers, defining mouse-3 to web interface." + :group 'debian-changelog + :type 'boolean) + +(defcustom debian-changelog-use-imenu (fboundp 'imenu-add-to-menubar) + "*Use imenu package for debian-changelog-mode? +If you do not wish this behaviour, reset it in your .emacs file like so: + + (setq debian-changelog-use-imenu nil)" + :group 'debian-changelog + :type 'boolean) + +;; This solves the consistency problem with `debian-changelog-close-bug' +;; as per bug #431091 +(defcustom debian-changelog-close-bug-statement "(Closes: #%s)." + "The text to be inserted to close a bug. `%s' is replaced by +the bug number." + :group 'debian-changelog + :type 'string) + +(defcustom debian-changelog-mode-hook nil + "Normal hook run when entering Debian Changelog mode." + :group 'debian-changelog + :type 'hook + :options '(turn-on-auto-fill flyspell-mode)) + +(defcustom debian-changelog-add-version-hook + (list 'debian-changelog-add-new-upstream-release) + "Hooks run just before inserting the signature separator \"--\" in a +new version in debian/changelog." + :group 'debian-changelog + :type 'hook) + +(defcustom debian-changelog-date-utc-flag nil + "If non-nil, return date string in UTC when finalizing entry. +See function `debian-changelog-date-string'." + :group 'debian-changelog + :type 'boolean) + +;; This function is from emacs/lisp/calendar/icalendar.el, +;; necessary to replace "%s" with the bug number in +;; `debian-changelog-close-bug-statement' +(defsubst debian-changelog--rris (&rest args) + "Replace regular expression in string. +Pass ARGS to `replace-regexp-in-string' (GNU Emacs) or to +`replace-in-string' (XEmacs)." + ;; XEmacs: + (if (fboundp 'replace-in-string) + (save-match-data ;; apparently XEmacs needs save-match-data + ;; and arguments are in different order. + ;; Patch from Rafael Laboissiere + ;; Closes: #476271 + (apply 'replace-in-string (list (nth 2 args) (nth 0 args) (nth 1 args)))) + ;; Emacs: + (apply 'replace-regexp-in-string args))) + +(defvar debian-changelog-local-variables-maybe-remove-done nil + "Internal flag so we prompt only once.") + +(autoload 'debian-bug-web-bug "debian-bug") +(autoload 'debian-bug-web-bugs "debian-bug") +(autoload 'debian-bug-web-packages "debian-bug") +(autoload 'debian-bug-web-package "debian-bug") +(autoload 'debian-bug-bug-menu-init "debian-bug") +(autoload 'debian-bug-web-this-bug-under-mouse "debian-bug") +(autoload 'debian-bug-web-developer-page "debian-bug") +(defvar debian-bug-open-alist) + + +(require 'add-log) +(require 'easymenu) +(eval-when-compile + (require 'cl)) + +;; XEmacs21.1 compatibility -- from XEmacs's apel/poe.el +(unless (fboundp 'match-string-no-properties) + (defun match-string-no-properties (num &optional string) + "Return string of text matched by last search, without text 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. +STRING should be given if the last search was by `string-match' on STRING." + (if (match-beginning num) + (if string + (let ((result + (substring string (match-beginning num) (match-end num)))) + (set-text-properties 0 (length result) nil result) + result) + (buffer-substring-no-properties (match-beginning num) + (match-end num)))))) +;; +;; Clean up old "Local Variables:" entries +;; Peter Galbraith + +;; **Important note** +;; +;; If we get the following warning: +;; +;; File local-variables error: (error "Local variables entry is missing the prefix") +;; +;; when installing the dpkg-dev-el package, it's because the command +;; (hack-local-variables) from files.el is bailing on all the "Local +;; Variables:" strings in this file. The simplest solution is to keep all +;; occurrences of this string before the last 3000 characters of the file, +;; where `hack-local-variables' starts looking: + +;; First, I made the add-log-mailing-address variable obsolete but still +;; left the "mode:" line in the variable block for Debian native packages +;; because it was impossible to tell what they were from the installed +;; changelog.gz name. In bug #105889, I came up with code to stick in +;; /etc/emacs/site-start.d/50dpkg-dev-el.el to figure that out in a +;; find-file-hooks hook. So now the variable block is completely obsolete. +(defun debian-changelog-local-variables-maybe-remove () + "Ask to remove local variables block if buffer not read-only." + (interactive) + (if (or debian-changelog-local-variables-maybe-remove-done + buffer-read-only) + nil + (setq debian-changelog-local-variables-maybe-remove-done t) + (if (debian-changelog-local-variables-exists-p) + (save-excursion + (goto-char (point-max)) ; local vars are always at end + (if (yes-or-no-p + "Remove obsolete \"local variables:\" from changelog? ") + (debian-changelog-local-variables-remove)))))) + +(defun debian-changelog-local-variables-exists-p () + "Return t if package has a \"Local Variables:\" block." + (save-excursion + (let ((case-fold-search t)) + (goto-char (point-max)) + (and (re-search-backward "^local variables:" nil t) + (or (re-search-forward "add-log-mailing-address:" nil t) + (re-search-forward "mode: debian-changelog" nil t)))))) + +(defun debian-changelog-local-variables-remove () + "Remove `add-log-mailing-address' entry from local variables block." + (save-excursion + (let ((case-fold-search t)) + (goto-char (point-max)) + ;; Remove add-log-mailing-address: line if it exists + (if (and (re-search-backward "^local variables:" nil t) + (re-search-forward "add-log-mailing-address: .+\n" nil t)) + (delete-region (match-beginning 0)(match-end 0))) + (goto-char (point-max)) + ;; Remove "mode: debian-changelog" line if it exists + (if (and (re-search-backward "^local variables:" nil t) + (re-search-forward "mode: debian-changelog.*\n" nil t)) + (delete-region (match-beginning 0)(match-end 0))) + (goto-char (point-max)) + ;; Remove empty variable block if it exists + (if (re-search-backward "^local variables: *\nend:" nil t) + (delete-region (match-beginning 0)(match-end 0)))))) + +;; +;; internal functions: getheadervalue and setheadervalue both use a +;; regexp to probe the changelog entry for specific fields. + +;; warning: if used with a "re" that doesn't have at least one group, +;; the results will be unpredictable (to say the least). + +(defun debian-changelog-setheadervalue (re str) + (if (eq (debian-changelog-finalised-p) t) + (error (substitute-command-keys "most recent version has been finalised - use \\[debian-changelog-unfinalise-last-version] or \\[debian-changelog-add-version]"))) + (let ((lineend (save-excursion (end-of-line)(point)))) + (save-excursion + (goto-char (point-min)) + (if (re-search-forward re lineend t) + (let ((a (match-beginning 1)) + (b (match-end 1))) + (goto-char a) + (delete-region a b) + (insert str)))))) + +(defun debian-changelog-getheadervalue (re) + (let ((lineend (save-excursion (end-of-line) (point)))) + (save-excursion + (goto-char (point-min)) + (re-search-forward re lineend) + (buffer-substring-no-properties (match-beginning 1) (match-end 1))))) + +;; +;; some get/set functions for specific fields +;; (Chris Waters) + +(defun debian-changelog-seturgency (val) + (debian-changelog-setheadervalue "\\;[^\n]* urgency=\\(\\sw+\\)" val)) +(defun debian-changelog-geturgency () + (debian-changelog-getheadervalue "\\;[^\n]* urgency=\\(\\sw+\\)")) +(defun debian-changelog-getdistribution () + (debian-changelog-getheadervalue ") \\(.*\\)\\;")) +(defvar last-nonmenu-event) +(defun debian-changelog-setdistribution (val) + (if (not (string-match "^.*security" val)) + (debian-changelog-setheadervalue ") \\(.*\\)\\;" val) + (cond + ((or (and (fboundp 'should-use-dialog-box-p) + (should-use-dialog-box-p)) + (and window-system + (equal last-nonmenu-event '(menu-bar)) + use-dialog-box)) + (if (y-or-n-p + (concat + "Warning, although the {oldstable,stable,testing}-security +distribution exists it should not be used unless you are a +member of the security team. Please don't upload to it if you +are not 150% sure that your package is suitable. In case of +doubt, please send the files to team@security.debian.org via +mail instead. + +Upload to " val " anyway?")) + (debian-changelog-setheadervalue ") \\(.*\\)\\;" val))) + (t + (let ((window-config (current-window-configuration))) + (with-output-to-temp-buffer "*Help*" + (princ (concat + "Warning, although the {oldstable,stable,testing}-security +distribution exists it should not be used unless you are a +member of the security team. Please don't upload to it if you +are not 150% sure that your package is suitable. In case of +doubt, please send the files to team@security.debian.org via +mail instead. + +Upload to " val " anyway?"))) + (if (y-or-n-p (format "Upload to %s anyway? " val)) + (debian-changelog-setheadervalue ") \\(.*\\)\\;" val)) + (set-window-configuration window-config)))))) + +;; +;; keymap table definition +;; + +(autoload 'outline-next-visible-heading "outline") +(autoload 'outline-prev-visible-heading "outline") + +(defvar debian-changelog-mode-map nil + "Keymap for Debian changelog major mode.") +(if debian-changelog-mode-map + nil + (setq debian-changelog-mode-map (make-sparse-keymap)) + (define-key debian-changelog-mode-map "\C-c\C-a" + 'debian-changelog-add-entry) + (define-key debian-changelog-mode-map "\C-c\C-o" + 'debian-changelog-build-open-bug-list) + (define-key debian-changelog-mode-map "\C-c\C-b" + 'debian-changelog-close-bug) + (define-key debian-changelog-mode-map "\C-c\C-f" + 'debian-changelog-finalise-last-version) + (define-key debian-changelog-mode-map "\C-c\C-c" + 'debian-changelog-finalise-and-save) + (define-key debian-changelog-mode-map "\C-c\C-v" + 'debian-changelog-add-version) + (define-key debian-changelog-mode-map "\C-c\C-d" + 'debian-changelog-distribution) + (define-key debian-changelog-mode-map "\C-c\C-u" + 'debian-changelog-urgency) + (define-key debian-changelog-mode-map "\C-c\C-e" + 'debian-changelog-unfinalise-last-version) + (define-key debian-changelog-mode-map "\C-c\C-n" + 'outline-next-visible-heading) + (define-key debian-changelog-mode-map "\C-c\C-p" + 'outline-previous-visible-heading)) + + +;; +;; menu definition (Chris Waters) +;; + +(defvar debian-changelog-is-XEmacs + (and + (not (null (save-match-data (string-match "XEmacs\\|Lucid" emacs-version)))) + (= 21 emacs-major-version))) + +(cond + (debian-changelog-is-XEmacs +(easy-menu-define + debian-changelog-menu debian-changelog-mode-map "Debian Changelog Mode Menu" + '("Changelog" + ["New Version" debian-changelog-add-version (debian-changelog-finalised-p)] + ["Add Entry" debian-changelog-add-entry + (not (debian-changelog-finalised-p))] + ["Build Open Bug List" debian-changelog-build-open-bug-list] + ["Close Bug" debian-changelog-close-bug + (not (debian-changelog-finalised-p))] + "--" + ("Set Distribution" + ["unstable" (debian-changelog-setdistribution "unstable") t] + ("--") + ["testing" (debian-changelog-setdistribution "testing") t] + ["testing-security" (debian-changelog-setdistribution "testing-security") t] + ("--") + ["stable" (debian-changelog-setdistribution "stable") t] + ["stable-security" (debian-changelog-setdistribution "stable-security") t] + ["stable-proposed-updates" (debian-changelog-setdistribution "stable-proposed-updates") t] + ("--") + ["oldstable-security" (debian-changelog-setdistribution "oldstable-security") t] + ["oldstable-proposed-updates" (debian-changelog-setdistribution "oldstable-proposed-updates") t] + ("--") + ["experimental" (debian-changelog-setdistribution "experimental") t] + ["UNRELEASED" (debian-changelog-setdistribution "UNRELEASED") t]) + ("Set Urgency" + ["low" (debian-changelog-seturgency "low") t] + ["medium" (debian-changelog-seturgency "medium") t] + ["high" (debian-changelog-seturgency "high") t] + ["critical" (debian-changelog-seturgency "critical") t]) + "--" + ["Unfinalise" debian-changelog-unfinalise-last-version + (debian-changelog-finalised-p)] + ["Finalise" debian-changelog-finalise-last-version + (not (debian-changelog-finalised-p))] + ["Finalise+Save" debian-changelog-finalise-and-save + (not (debian-changelog-finalised-p))] + "--" + "Web View" + ["Best Practices" (browse-url "http://www.debian.org/doc/developers-reference/best-pkging-practices.html#bpp-debian-changelog") t] + ["Bugs for This Package" (debian-bug-web-bugs) t] + ["Archived Bugs for This Package" (debian-bug-web-bugs t) t] + ["Bug Number..." (debian-bug-web-bug) t] + ["Package Info" (debian-bug-web-packages) t] +;; ("Package web pages..." +;; ["stable" (debian-bug-web-package "stable") t] +;; ["testing" (debian-bug-web-package "testing") t] +;; ["unstable" (debian-bug-web-package "unstable") t]) + ["Developer Page for This Package" (debian-bug-web-developer-page) t] + ["Developer Page for This Maintainer" (debian-changelog-web-developer-page) + t] + "--" + ["Customize" (customize-group "debian-changelog") (fboundp 'customize-group)]))) + (t +(easy-menu-define + debian-changelog-menu debian-changelog-mode-map "Debian Changelog Mode Menu" + '("Changelog" + ["New Version" debian-changelog-add-version (debian-changelog-finalised-p)] + ["Add Entry" debian-changelog-add-entry + (not (debian-changelog-finalised-p))] + ["Build Open Bug List" debian-changelog-build-open-bug-list] + ["Close Bug" debian-changelog-close-bug + (not (debian-changelog-finalised-p))] + "--" + ("Set Distribution" :active (not (debian-changelog-finalised-p)) + ["unstable" (debian-changelog-setdistribution "unstable") t] + ("--") + ["testing" (debian-changelog-setdistribution "testing") t] + ["testing-security" (debian-changelog-setdistribution "testing-security") t] + ("--") + ["stable" (debian-changelog-setdistribution "stable") t] + ["stable-security" (debian-changelog-setdistribution "stable-security") t] + ["stable-proposed-updates" (debian-changelog-setdistribution "stable-proposed-updates") t] + ("--") + ["oldstable-security" (debian-changelog-setdistribution "oldstable-security") t] + ["oldstable-proposed-updates" (debian-changelog-setdistribution "oldstable-proposed-updates") t] + ("--") + ["experimental" (debian-changelog-setdistribution "experimental") t] + ["UNRELEASED" (debian-changelog-setdistribution "UNRELEASED") t]) + ("Set Urgency" :active (not (debian-changelog-finalised-p)) + ["low" (debian-changelog-seturgency "low") t] + ["medium" (debian-changelog-seturgency "medium") t] + ["high" (debian-changelog-seturgency "high") t] + ["critical" (debian-changelog-seturgency "critical") t]) + "--" + ["Unfinalise" debian-changelog-unfinalise-last-version + (debian-changelog-finalised-p)] + ["Finalise" debian-changelog-finalise-last-version + (not (debian-changelog-finalised-p))] + ["Finalise+Save" debian-changelog-finalise-and-save + (not (debian-changelog-finalised-p))] + "--" + "Web View" + ["Best Practices" (browse-url "http://www.debian.org/doc/developers-reference/ch-best-pkging-practices.en.html#s-bpp-debian-changelog") t] + ["Bugs for This Package" (debian-bug-web-bugs) t] + ["Archived Bugs for This Package" (debian-bug-web-bugs t) t] + ["Bug Number..." (debian-bug-web-bug) t] + ["Package Info" (debian-bug-web-packages) t] + ("Package web pages..." + ["stable" (debian-bug-web-package "stable") t] + ["testing" (debian-bug-web-package "testing") t] + ["unstable" (debian-bug-web-package "unstable") t]) + ["Developer Page for This Package" (debian-bug-web-developer-page) t] + ["Developer Page for This Maintainer" (debian-changelog-web-developer-page) + t] + "--" + ["Customize" (customize-group "debian-changelog") (fboundp 'customize-group)])))) + +;; +;; interactive function to add a new line to the changelog +;; + +;;;###autoload +(defun debian-changelog-add-entry () + "Add a new change entry to a debian-style changelog. +If called from buffer other than a debian/changelog, this will search +for the debian/changelog file to add the entry to." + (interactive) + (if (string-match ".*/debian/changelog" (buffer-file-name)) + (debian-changelog-add-entry-plain) + (debian-changelog-add-entry-file))) + +(defun debian-changelog-add-entry-plain () + "Add a new change entry to a debian-style changelog." + (if (eq (debian-changelog-finalised-p) t) + (error (substitute-command-keys "most recent version has been finalised - use \\[debian-changelog-unfinalise-last-version] or \\[debian-changelog-add-version]"))) + (goto-char (point-min)) + (re-search-forward "\n --") + (backward-char 5) + (if (prog1 (looking-at "\n") (forward-char 1)) + nil + (insert "\n")) + (insert " * ") + (save-excursion (insert "\n"))) + +(defun debian-changelog-add-entry-file () + "Add an entry for current file in debian/changelog." + (let* ((this-file (buffer-file-name)) + (directory (if (not this-file) + (error "This buffer has no file associated to it") + (directory-file-name (file-name-directory this-file)))) + (filename (file-name-nondirectory this-file)) + (success)) + (while directory + (let ((changelog (expand-file-name "debian/changelog" directory))) + (cond + ((file-readable-p changelog) + (debian-changelog-add-entry-file-specified changelog filename) + (setq directory nil + success t)) + (t + (if (not (string-match "\\(.*\\)/\\([^/]+\\)$" directory)) + (setq directory nil) + (setq filename (concat (match-string 2 directory) "/" filename) + directory (match-string 1 directory))))))) + (if (not success) + (error "debian directory not found")))) + +(defun debian-changelog-add-entry-file-specified (changelog filename) + "Insert an entry in debian CHANGELOG file for FILENAME." + (interactive) + (find-file changelog) + (if (eq (debian-changelog-finalised-p) t) + (let ((action (capitalize + (read-string + "Most recent version is finalised, [u]nfinalize or [a]dd new version? ")))) + (if (not (string-match "^[uU]" action)) + (debian-changelog-add-version) + (debian-changelog-unfinalise-last-version) + (debian-changelog-add-entry-plain))) + (debian-changelog-add-entry-plain)) + (insert filename ": ")) + +;; +;; interactive function to close bugs by number. (Peter Galbraith) +;; + +(defvar debian-changelog-close-bug-takes-arg t + "A compatibility flag for debian-bug.el.") + +(defun debian-changelog-build-open-bug-list () + "Generate open bugs list, i.e. `debian-bug-open-alist'." + (interactive) + (debian-bug-build-bug-menu (debian-changelog-suggest-package-name) t)) + +(defun debian-changelog-close-bug (bug-number) + "Add a new change entry to close a BUG-NUMBER." + (interactive + (progn + (if (eq (debian-changelog-finalised-p) t) + (error (substitute-command-keys "most recent version has been finalised - use \\[debian-changelog-unfinalise-last-version] or \\[debian-changelog-add-version]"))) + (list (completing-read "Bug number to close: " + debian-bug-open-alist nil nil)))) + (if (not (string-match "^[0-9]+$" bug-number)) + (error "The bug number should consists of only digits")) + (debian-changelog-add-entry) + (cond + ((and debian-bug-open-alist + (assoc bug-number debian-bug-open-alist)) + (insert (cadr (assoc bug-number debian-bug-open-alist))) + (fill-paragraph nil)) + (t + (save-excursion + (insert " " (debian-changelog--rris + "%s" bug-number debian-changelog-close-bug-statement))) + (message "Enter a brief description of what was done here.")))) + +;; +;; interactive functions to set urgency and distribution +;; + +(defun debian-changelog-distribution () + "Delete the current distribution and prompt for a new one." + (interactive) + (if (eq (debian-changelog-finalised-p) t) + (error (substitute-command-keys "most recent version has been finalised - use \\[debian-changelog-unfinalise-last-version] or \\[debian-changelog-add-version]"))) + (let ((str (completing-read + "Select distribution: " + debian-changelog-allowed-distributions + nil t nil))) + (if (not (equal str "")) + (debian-changelog-setdistribution str)))) + +(defun debian-changelog-urgency () + "Delete the current urgency and prompt for a new one." + (interactive) + (if (eq (debian-changelog-finalised-p) t) + (error (substitute-command-keys "most recent version has been finalised - use \\[debian-changelog-unfinalise-last-version] or \\[debian-changelog-add-version]"))) + (let ((str (completing-read + "Select urgency: " + '(("low" 1) ("medium" 2) ("high" 3) ("critical" 4)) + nil t nil))) + (if (not (equal str "")) + (debian-changelog-seturgency str)))) + +;; +;; internal function: test if changelog has been finalized or not +;; New version by Tommi Virtanen +;; Sun, 24 Jun 2001 16:03:01 UTC; Debian bug #102088 +;; - +;; regexp tweaked by psg, Tue Jul 10 15:29:54 EDT 2001 + +(defun debian-changelog-finalised-p () + "Check whether the most recent debian-style changelog entry is finalised yet. +\(ie, has a maintainer name and email address and a release date." + (save-excursion + (goto-char (point-min)) + (or (re-search-forward "\n\\S-" (point-max) t) + (goto-char (point-max))) + (if (re-search-backward "\n --" (point-min) t) + (forward-char 4) + ;;(beginning-of-line) + ;;(insert " --\n\n") + ;;(backward-char 2) + ) + (cond + ((looking-at + "[ \n]+\\S-[^\n\t]+\\S- <[^ \t\n<>]+> +\\S-[^\t\n]+\\S-[ \t]*\n") + t) + ((looking-at "[ \t]*\n") + nil) + (t + "finalisation line has bad format (not ` -- maintainer date')")))) +;; +;; interactive functions to add new versions (whole new sections) +;; to changelog. +;; + +(defvar debian-changelog-new-upstream-release-p nil) + +(defun debian-changelog-add-new-upstream-release () + "Normal hook for adding \"new upstream release\" entry to changelog." + (when debian-changelog-new-upstream-release-p + (insert "New upstream release") + (setq debian-changelog-new-upstream-release-p nil))) + +(defun debian-changelog-add-version () + "Add a new version section to a debian-style changelog file. +If file is empty, create initial entry." + (interactive) + (if (not (= (point-min)(point-max))) + (let ((f (debian-changelog-finalised-p))) + (and (stringp f) (error f)) + (or f (error "Previous version not yet finalised")))) + (goto-char (point-min)) + (let ((pkg-name (or (debian-changelog-suggest-package-name) + (read-string "Package name: "))) + (version (or (debian-changelog-suggest-version) + (read-string "New version (including any revision): ")))) + (if (debian-changelog-experimental-p) + (insert pkg-name " (" version ") experimental; urgency=medium\n\n * ") + (insert pkg-name " (" version ") " (car debian-changelog-allowed-distributions) "; urgency=medium\n\n * ")) + (run-hooks 'debian-changelog-add-version-hook) + (save-excursion (insert "\n\n --\n\n")))) + +(defun debian-changelog-experimental-p () +;; Peter S Galbraith, 04 May 2001 + "Return t if last upload is to experimental." + (save-excursion + (goto-char (point-min)) + (looking-at "\\sw.* (.+).* \\(experimental\\)"))) + +(defun debian-changelog-suggest-package-name () +;; Peter S Galbraith, 23 Feb 2001 + "Return package name from first line of the changelog, or nil." + (save-excursion + (goto-char (point-min)) + (if (looking-at + "\\(\\S-+\\) +(\\([^()\n\t-]+\\)\\(-\\([^()]+\\)\\)?\\() +[^\n]*\\)") + (match-string-no-properties 1)))) + +(defun debian-changelog-greater-than (vsn1 vsn2) + "Return t if VSN1 is greater than VSN2." + (save-excursion + (let ((tmp-buffer (get-buffer-create + " *debian-changelog-mode-temp-buffer*"))) + (set-buffer tmp-buffer) + (unwind-protect + (progn + (let ((mesg (call-process "dpkg" nil '(t nil) nil + "--compare-versions" vsn1 "gt" vsn2))) + (if (equal mesg 0) + t + nil))) + (kill-buffer tmp-buffer))))) + +(defun debian-changelog-suggest-version () +;; Peter S Galbraith, 23 Feb 2001 + "Return a suggested new version number to use for this changelog, or nil." + (save-excursion + (goto-char (point-min)) + (let ((findmatch t)) + (cond + ((looking-at +;;; The following is not strictly correct. The upstream version may actually +;;; contain a hyphen if a debian version number also exists, making two hyphens +;;; I'm also assuming it begins with a digit, which is not enforced + "\\(\\S-+\\) +(\\([0-9]:\\)?\\([0-9][0-9a-zA-Z.+:~]*\\)\\(-\\([0-9a-zA-Z.+~]+\\)\\)?\\() +[^\n]*\\)")) + + ;; No match... + ;; Check again for multiple hyphens, and adjust match-data if found + ;; to leave only the bit past the last hyphen as the debian version + ;; number. + ((looking-at + "\\(\\S-+\\) +(\\([0-9]:\\)?\\([0-9][0-9a-zA-Z.+:~]*\\)\\(-\\([0-9a-zA-Z.+~]+\\)\\)*\\() +[^\n]*\\)") + ;; We have a hit. Adjust match-data... + (goto-char (match-end 5)) + (skip-chars-backward "0-9a-zA-Z.+~") + (let ((deb-vsn-beg (point)) + (ups-vsn-end (1- (point)))) + (store-match-data + (list + (match-beginning 0)(match-end 0) + (match-beginning 1)(match-end 1) + (match-beginning 2)(match-end 2) + (match-beginning 3) ups-vsn-end + (match-beginning 4)(match-end 4) + deb-vsn-beg (match-end 5) + (match-beginning 6)(match-end 6))))) + (t + (setq findmatch nil))) + + +;;; match 1: package name +;;; match 2: epoch, if it exists +;;; match 3: upstream version number +;;; match 4: debian version number exists if matched +;;; match 5: debian version number +;;; match 6: rest of string + (if (not findmatch) + nil + (let ((pkg-name (match-string-no-properties 1)) + (epoch (or (match-string-no-properties 2) "")) + (upstream-vsn (match-string-no-properties 3)) + (debian-vsn (match-string-no-properties 5))) + ;;debug (message "name: %s epoch: %s version: %s debian: %s" pkg-name epoch upstream-vsn debian-vsn)))) + + (cond + ;; Debian vsn exists + Old upstream version matches current one. + ;; -> Increment Debian version... + ((and debian-vsn + (string-match + (regexp-quote (concat "/" pkg-name "-" upstream-vsn "/debian/changelog")) + buffer-file-name)) + (concat epoch upstream-vsn "-" + (debian-changelog-increment-version debian-vsn))) + + ;; Same as above, but more general in case directory name doesn't + ;; match package name. -> Increment Debian version... + ((and debian-vsn + (string-match + (concat "-" (regexp-quote upstream-vsn) "/debian/changelog") + buffer-file-name)) + (concat epoch upstream-vsn "-" + (debian-changelog-increment-version debian-vsn))) + + ;; Debian vsn exists but old upstream version doesn't match new one. + ;; -> Use new upstream version with "-1" debian version. +;;;FIXME: I should perhaps check that the directory name version is higher +;;;than that currently in changelog. + ((and debian-vsn + (string-match (concat + "/" + (regexp-quote pkg-name) + "-\\([0-9][0-9a-zA-Z.+~-]+\\)/debian/changelog") + buffer-file-name)) + (setq debian-changelog-new-upstream-release-p t) + (concat epoch (match-string 1 buffer-file-name) "-1")) + + ;; Same as above, but more general in case directory name doesn't + ;; match package name. + ;; -> Use new upstream version with "-1" debian version. + ((and debian-vsn + (string-match + (concat "-\\([0-9][0-9a-zA-Z.+~-]+\\)/debian/changelog") + buffer-file-name)) + (setq debian-changelog-new-upstream-release-p t) + (concat epoch (match-string 1 buffer-file-name) "-1")) + + ;; Debian vsn exists, but directory name has no version + ;; -> increment Debian vsn (no better guess) + (debian-vsn + (concat epoch upstream-vsn "-" + (debian-changelog-increment-version debian-vsn))) + + ;;; No Debian version number... + + ;; No debian version number and version number from changelog + ;; already greater than from directory name. + ((and (not debian-vsn) + (not (string-match + (concat "/" (regexp-quote pkg-name) "-" + (regexp-quote upstream-vsn) "/debian/changelog") + buffer-file-name)) + (string-match (concat "/" (regexp-quote pkg-name) + "-\\([0-9a-zA-Z.+~]+\\)/debian/changelog") + buffer-file-name) + (debian-changelog-greater-than + upstream-vsn (match-string 1 buffer-file-name))) + (concat epoch (debian-changelog-increment-version upstream-vsn))) + + ;; No debian version number (Debian native) and old upstream + ;; version matches new one (e.g. 'dpk-source -x package' without + ;; then bumping up the version in the directory name. + ((and (not debian-vsn) + (string-match (concat "/" (regexp-quote pkg-name) "-" + (regexp-quote upstream-vsn) + "/debian/changelog") + buffer-file-name) + (concat epoch + (debian-changelog-increment-version upstream-vsn)))) + + ;; No debian version number and version number from changelog + ;; less than from directory name. + ((and (not debian-vsn) + (not (string-match + (concat "/" (regexp-quote pkg-name) "-" + (regexp-quote upstream-vsn) "/debian/changelog") + buffer-file-name)) + (string-match (concat + "/" (regexp-quote pkg-name) + "-\\([0-9a-zA-Z.+~]+\\)/debian/changelog") + buffer-file-name) + (debian-changelog-greater-than + (match-string 1 buffer-file-name) upstream-vsn)) + (concat epoch (match-string 1 buffer-file-name))) + + ((string-match (concat "/" (regexp-quote pkg-name) + "-\\([0-9a-zA-Z.+~]+\\)/debian/changelog") + buffer-file-name) + ;;Hmmm.. return version number from directory if we get this far + (concat epoch (match-string 1 buffer-file-name))) + ((string-match + (concat "-\\([0-9][0-9a-zA-Z.+~]+\\)/debian/changelog") + buffer-file-name) + ;;Hmmm.. return version number from directory if we get this far + (concat epoch (match-string 1 buffer-file-name))) + + ;; Directory name has no version -> increment what we have. + (t + (concat epoch + (debian-changelog-increment-version upstream-vsn))))))))) + +(defun debian-changelog-increment-version (version) +;; Peter S Galbraith, 09 Mar 2001 + "Increment the last numeric portion of a VERSION number. +1 -> 2 +0potato1 -> 0potato2 +1.01 -> 1.02" + (cond + ((string-match "[1-9][0-9]*$" version) + (let ((first-part (substring version 0 (match-beginning 0))) + (snd-part (match-string 0 version))) + (concat + first-part (number-to-string (+ 1 (string-to-number snd-part)))))) + ((string-match "[0-9]*$" version) + ;; 3.5.4.0 -> 3.5.4.1 + (let ((first-part (substring version 0 (match-beginning 0))) + (snd-part (match-string 0 version))) + (concat + first-part (number-to-string (+ 1 (string-to-number snd-part)))))) + (t + ;; Safety net only - first condition should catch all + (number-to-string (+ 1 (string-to-number version)))))) + +(defun debian-changelog-finalise-and-save () + "Finalise, if necessary, and then save a debian-style changelog file." + (interactive) + (let ((f (debian-changelog-finalised-p))) + (and (stringp f) (error f)) + (or f (debian-changelog-finalise-last-version))) + (save-buffer)) + +;; +;; internal function to get date as string (used by finalising routines) +;; + +(defun debian-changelog-date-string () + "Return RFC-822 format date string. +Use UTC if `debian-changelog-date-utc-flag' is non-nil." + (let ((system-time-locale "C")) + (format-time-string "%a, %d %b %Y %T %z" nil + debian-changelog-date-utc-flag))) +;; +;; interactive functions to finalize entry +;; + +;;; Use debian-changelog-full-name and debian-changelog-mailing-address instead +;; (make-local-variable 'add-log-full-name) +;; (make-local-variable 'add-log-mailing-address) + +(defun debian-changelog-finalise-last-version () + "Finalise maintainer's name and email and release date." + (interactive) + (and (debian-changelog-finalised-p) + (debian-changelog-unfinalise-last-version)) + (if debian-changelog-local-variables-maybe-remove + (debian-changelog-local-variables-maybe-remove)) + (save-excursion + (goto-char (point-min)) + (re-search-forward "\n --\\([ \t]*\\)") + (delete-region (match-beginning 1) (match-end 1)) + (insert " " debian-changelog-full-name + " <" debian-changelog-mailing-address "> " + (debian-changelog-date-string)))) + +(defun debian-changelog-last-maintainer () + "Return maintainer name and e-mail of the last changelog entry as +a list in the form (NAME EMAIL)." + (save-excursion + (goto-char (point-min)) + (let ((string + (if (re-search-forward "^ -- \\(.*\\)>" nil t) + (if (fboundp 'match-string-no-properties) + (match-string-no-properties 1) + (match-string 1)) + (error "Maintainer name and email not found.")))) + (split-string string " <")))) + +(defun debian-changelog-web-developer-page () + "Browse the BTS for the last upload maintainer's developer summary page." + (interactive) + (if (not (featurep 'browse-url)) + (progn + (load "browse-url" nil t) + (if (not (featurep 'browse-url)) + (error "This function requires the browse-url elisp package")))) + (let ((email (cadr (debian-changelog-last-maintainer)))) + (browse-url (concat "http://qa.debian.org/developer.php?login=" email)) + (message "Looking up developer summary page for %s via browse-url" email))) + +;; co-maintenance as per bug #352957 by Luca Capello 2006 +(defun debian-changelog-comaintainer-insert (name separator) + "In the line before SEPARATOR, insert the co-maintainer name as for +the form [ NAME ]." + (goto-char (point-min)) + (re-search-forward (concat "\n " separator)) + (previous-line 1) + (insert "\n [ " name " ]") + (when (string= "--" separator) + (insert "\n"))) + +(defun debian-changelog-comaintainer () + "If the last maintainer is different from the current one, create a +co-maintained changelog entry." + (let ((name (car (debian-changelog-last-maintainer)))) + (unless (string= name debian-changelog-full-name) + (let ((maintainers-found) + (debian-changelog-last-entry-end + (progn (goto-char (point-min)) + (re-search-forward "\n --")))) + (mapc (lambda (x) + (goto-char (point-min)) + (when (search-forward x debian-changelog-last-entry-end t) + (add-to-list 'maintainers-found x))) + (list name debian-changelog-full-name)) + ;; set the co-maintenance if any + (if maintainers-found + ;; co-maintenance, debian-changelog-full-name is not present + (if (and (member name maintainers-found) + (not (member debian-changelog-full-name + maintainers-found))) + (debian-changelog-comaintainer-insert + debian-changelog-full-name "--")) + ;; no co-maintenance + (mapc (lambda (x) + (debian-changelog-comaintainer-insert (car x) (cadr x))) + `((,name " *") (,debian-changelog-full-name "--")))))))) + +;; +;; interactive function to unfinalise changelog (so modifications can be made) +;; + +(defun debian-changelog-unfinalise-last-version () + "Remove the `finalisation' information. +Removes maintainer's name, email address and release date so that new entries +can be made." + (interactive) + (if (debian-changelog-finalised-p) nil + (error "Most recent version is not finalised")) + (save-excursion + (debian-changelog-comaintainer) + (goto-char (point-min)) + (re-search-forward "\n --") + (let ((dels (point))) + (end-of-line) + (delete-region dels (point))))) + +;; +;; top level interactive function to activate mode +;; + +(defvar imenu-create-index-function) +;;;###autoload +(defun debian-changelog-mode () + "Major mode for editing Debian-style change logs. +Runs `debian-changelog-mode-hook' if it exists. + +Key bindings: + +\\{debian-changelog-mode-map} + +If you want to use your debian.org email address for debian/changelog +entries without using it for the rest of your email, use the `customize` +interface to set it, or simply set the variable +`debian-changelog-mailing-address' in your ~/.emacs file, e.g. + + (setq debian-changelog-mailing-address \"myname@debian.org\"))" + + (interactive) + (kill-all-local-variables) + (setq major-mode 'debian-changelog-mode + mode-name "Debian changelog" + left-margin 2 + fill-prefix " " + fill-column 74) + ;;(hack-local-variables) + ;; Can't hack-local-varibles because a "mode: " creates an infinite loop. + ;; It doesn't matter anyway. The Local Variable block is parsed after + ;; the mode is run when visited by find-file. That's the only time it's + ;; done. + (use-local-map debian-changelog-mode-map) + ;; Let each entry behave as one paragraph: +; (set (make-local-variable 'paragraph-start) "\\*") +; (set (make-local-variable 'paragraph-separate) "\\*\\|\\s-*$|\\S-") + ;; PSG: The following appears to get fill-paragraph to finally work! + (set (make-local-variable 'paragraph-start) "\\*\\|\\s *$\\|\f\\|^\\<") + (set (make-local-variable 'paragraph-separate) "\\s *$\\|\f\\|^\\<") + ;; Let each version behave as one page. + ;; Match null string on the heading line so that the heading line + ;; is grouped with what follows. + (set (make-local-variable 'page-delimiter) "^\\<") + (set (make-local-variable 'version-control) 'never) + (set (make-local-variable 'adaptive-fill-regexp) "\\s *") + (set (make-local-variable 'font-lock-defaults) + '((debian-changelog-font-lock-keywords + debian-changelog-font-lock-keywords-1 + debian-changelog-font-lock-keywords-2) t t)) + (set (make-local-variable + 'debian-changelog-local-variables-maybe-remove-done) nil) + (set (make-local-variable 'indent-line-function) 'indent-relative-maybe) + (set (make-local-variable 'outline-regexp) "^[a-z]") + (setq local-abbrev-table text-mode-abbrev-table) + (set-syntax-table text-mode-syntax-table) + (debian-bug-bug-menu-init debian-changelog-mode-map) + (easy-menu-add debian-changelog-menu) + (cond + (debian-changelog-use-imenu + (require 'imenu) + (setq imenu-create-index-function 'imenu--create-debian-changelog-index) + (if (or window-system + (fboundp 'tmm-menubar)) + (progn + (imenu-add-to-menubar "History") + ;(imenu-update-menubar) + )))) + (cond + (debian-changelog-highlight-mouse-t + (debian-changelog-setup-highlight-mouse-keymap) + (debian-changelog-highlight-mouse))) + (run-hooks 'debian-changelog-mode-hook)) +;;(easy-menu-add debian-changelog-menu)) + +;; +;; font-lock face defs by Peter Galbraith + +(defvar debian-changelog-warning-face 'debian-changelog-warning-face + "Face to use for important keywords.") + +(cond + ((and (fboundp 'facep) + (facep 'font-lock-warning-face)) + (copy-face 'font-lock-warning-face 'debian-changelog-warning-face)) + ((fboundp 'defface) + (defface debian-changelog-warning-face + '((((class grayscale)(background light))(:foreground "DimGray" :bold t)) + (((class grayscale)(background dark))(:foreground "LightGray" :bold t)) + (((class color)(background light))(:foreground "red" :bold t )) + (((class color)(background dark))(:foreground "red" :bold t )) + (t (:bold t))) + "Face for debian-changelog important strings." + :group 'debian-changelog-faces)) + (t + ;;; XEmacs19: + (make-face 'debian-changelog-warning-face + "Face to use for important keywords.in debian-changelog-mode") + (make-face-bold 'debian-changelog-warning-face) + ;; XEmacs uses a tag-list thingy to determine if we are using color + ;; or mono (and I assume a dark background). + (set-face-foreground 'debian-changelog-warning-face + "red" 'global nil 'append))) + +;; +;; font-lock definition by Chris Waters, +;; revisited by Peter Galbraith (Apr 2001) + +;; Available faces: +;; keyword-face, type-face, string-face, comment-face, +;; variable-name-face, function-name-face +;; in emacs only: builtin-face, constant-face, warning-face +;; in xemacs only: reference-face, doc-string-face, preprocessor-face + +;; the mappings I've done below only use faces available in both emacsen. +;; this is somewhat limiting; I may consider adding my own faces later. + +(defvar debian-changelog-font-lock-keywords-1 + (list + ;; package name line: pkg (1.0-1) unstable; urgency=medium + '(debian-changelog-fontify-version + (1 font-lock-function-name-face) + (2 font-lock-type-face nil t) + (3 font-lock-string-face nil t) + (4 debian-changelog-warning-face nil t)) + '(debian-changelog-fontify-stable . debian-changelog-warning-face) + '(debian-changelog-fontify-backports . debian-changelog-warning-face) + '(debian-changelog-fontify-frozen . font-lock-type-face) + '(debian-changelog-fontify-unstable . font-lock-string-face) + '(debian-changelog-fontify-experimental . debian-changelog-warning-face) + '(debian-changelog-fontify-unreleased . debian-changelog-warning-face) + '(debian-changelog-fontify-urgency-crit . debian-changelog-warning-face) + '(debian-changelog-fontify-urgency-high . debian-changelog-warning-face) + '(debian-changelog-fontify-urgency-med . font-lock-type-face) + '(debian-changelog-fontify-urgency-low . font-lock-string-face) + ;; bug closers + '(;"\\(closes:\\) *\\(\\(bug\\)?#? *[0-9]+\\(, *\\(bug\\)?#? *[0-9]+\\)*\\)" + ;; Process lines that continue on multiple lines - Fred Bothamy + "\\(closes:\\)[ \t\n]*\\(\\(bug\\)?#? *[0-9]+\\(,[ \t\n]*\\(bug\\)?#? *[0-9]+\\)*\\)" + (1 font-lock-keyword-face) + (2 debian-changelog-warning-face)) + '("^\t.*$" . debian-changelog-warning-face) + ;; maintainer line (enforce 2 space exactly between email and date) + '("^ -- \\(.+\\) <\\(.+@.+\\)> \\([^ ].+\\)$" + (1 font-lock-variable-name-face) + (2 font-lock-variable-name-face) + (3 font-lock-string-face))) + "First level highlighting for `debian-changelog-mode'.") + +(defvar debian-changelog-font-lock-keywords-2 + (append + debian-changelog-font-lock-keywords-1 + ;; bullet lines + '(("^ +\\(\\*\\)" 1 font-lock-comment-face))) + "High level highlighting for `debian-changelog-mode'.") + +(defvar debian-changelog-font-lock-keywords + debian-changelog-font-lock-keywords-1 + "Default expressions to highlight in `debian-changelog-mode'.") + +;; Fontifier function by Peter Galbraith, Apr 24 2001 + +(defun debian-changelog-fontify-version (limit) + "Return match for package name and version number up to LIMIT. +match 1 -> package name + 2 -> native vsn number + 3 -> non-native vsn number + 4 -> non-native NMU vsn number" + (when (re-search-forward +;;; The following is not strictly correct. The upstream version may actually +;;; contain a hyphen if a debian version number also exists, making two hyphens +;;; I'm assuming it begins with a digit, which is not enforced + "^\\(\\S-+\\) (\\([0-9]:\\)?\\([0-9][0-9a-zA-Z.+:~]*\\)\\(-\\([0-9a-zA-Z.+~]+\\)\\)*)" nil t) +;; ^ +;; Note the asterix above, allowing more than one hyphen in the version +;; number, but wrongly assuming that all of it is the Debian version +;; instead of only the bit past the last hyphen. I might get NMUs wrongly +;; for version numbers with multiple hyphens. + +;; match 1: package name +;; match 2: epoch, if it exists +;; match 3: upstream version number +;; match 4: debian version number exists if matched +;; match 5: debian version number + (cond + ((not (match-string 4)) + ;; No Debian version number -> Debian native package + (store-match-data + (list (match-beginning 1)(match-end 3) + (match-beginning 1)(match-end 1) + (match-beginning 3)(match-end 3) + nil nil + nil nil))) + ((match-string 4) + ;; Debian version number -> Let's see if NMU... + (let* ((deb-vsn (match-string 5)) + (is-NMU (save-match-data (string-match "\\." deb-vsn)))) + (cond + (is-NMU + (store-match-data + (list (match-beginning 1)(match-end 5) + (match-beginning 1)(match-end 1) + nil nil + nil nil + (match-beginning 3)(match-end 5)))) + (t + (store-match-data + (list (match-beginning 1)(match-end 5) + (match-beginning 1)(match-end 1) + nil nil + (match-beginning 3)(match-end 5) + nil nil))))))) + t)) + +(defun debian-changelog-fontify-urgency-crit (limit) + (when (re-search-forward "^\\sw.* (.+).*; \\(urgency=critical\\)" limit t) + (store-match-data + (list (match-beginning 1)(match-end 1))) + t)) + +(defun debian-changelog-fontify-urgency-high (limit) + (when (re-search-forward "^\\sw.* (.+).*; \\(urgency=high\\)" limit t) + (store-match-data + (list (match-beginning 1)(match-end 1))) + t)) + +(defun debian-changelog-fontify-urgency-med (limit) + (when (re-search-forward "^\\sw.* (.+).*; \\(urgency=medium\\)" limit t) + (store-match-data + (list (match-beginning 1)(match-end 1))) + t)) + +(defun debian-changelog-fontify-urgency-low (limit) + (when (re-search-forward "^\\sw.* (.+).*; \\(urgency=low\\)" limit t) + (store-match-data + (list (match-beginning 1)(match-end 1))) + t)) + +(defun debian-changelog-fontify-stable (limit) + (when (re-search-forward "^\\sw.* (.+).* \\(\\(old\\)?stable\\(-security\\|-proposed-updates\\)?\\)" limit t) + (store-match-data + (list (match-beginning 1)(match-end 1))) + t)) + +(defun debian-changelog-fontify-frozen (limit) + (when (re-search-forward "^\\sw.* (.+).* \\(testing\\(-security\\)?\\|frozen\\|woody-proposed-updates\\)" limit t) + (store-match-data + (list (match-beginning 1)(match-end 1))) + t)) + +(defun debian-changelog-fontify-unstable (limit) + (when (re-search-forward "^\\sw.* (.+).* \\(unstable\\)" limit t) + (store-match-data + (list (match-beginning 1)(match-end 1))) + t)) + +(defun debian-changelog-fontify-experimental (limit) + (when (re-search-forward "^\\sw.* (.+).* \\(experimental\\)" limit t) + (store-match-data + (list (match-beginning 1)(match-end 1))) + t)) + +(defun debian-changelog-fontify-unreleased (limit) + (when (re-search-forward "^\\sw.* (.+).* \\(UNRELEASED\\)" limit t) + (store-match-data + (list (match-beginning 1)(match-end 1))) + t)) + +(defun debian-changelog-fontify-backports (limit) + (when (re-search-forward "^\\sw.* (.+).* \\([a-z][a-z]*-backports\\)" limit t) + (store-match-data + (list (match-beginning 1)(match-end 1))) + t)) + +;; +;; browse-url interfaces, by Peter Galbraith, Feb 23 2001 +;; + +(defvar debian-changelog-is-XEmacs + (not (null (save-match-data (string-match "XEmacs\\|Lucid" emacs-version))))) + +(defvar debian-changelog-mouse-keymap nil + "Keymap for mouse commands.") + +(defun debian-changelog-setup-highlight-mouse-keymap () + (setq debian-changelog-mouse-keymap + ;;; First, copy the local keymap so we don't have `disappearing' menus + ;;; when the mouse is moved over a bug number. + + ;;; FIXME: Check out (mouse-major-mode-menu) to see how it grabs the local + ;;; menus to display. + (let ((m (copy-keymap (current-local-map)))) +;; (cond +;; ((and debian-changelog-use-imenu +;; (or window-system (fboundp 'tmm-menubar))) +;; (imenu-add-to-menubar "History"))) + (cond + (debian-changelog-is-XEmacs + (set-keymap-name m 'debian-changelog-mouse-keymap) + (define-key m [button3] + 'debian-bug-web-this-bug-under-mouse)) + (t + (define-key m [down-mouse-3] + 'debian-bug-web-this-bug-under-mouse))) + m))) + +(defvar debian-changelog-ext-list nil + "XEmacs buffer-local list of debian-changelog-cite extents.") +(make-variable-buffer-local 'debian-changelog-ext-list) +(put 'debian-changelog-ext-list 'permanent-local t) + +(defun debian-changelog-highlight-mouse () + "Make that nice green highlight when the mouse is over a bug number. +Also set keymap." + (interactive) + (save-excursion + (let ((s)(e)(extent)(local-extent-list debian-changelog-ext-list) + (inhibit-read-only t) + (modified (buffer-modified-p))) ;put-text-property changing this? + ;; Remove the mouse face properties first. + (setq debian-changelog-ext-list nil) ;Reconstructed below... + (if (string-match "XEmacs\\|Lucid" emacs-version) + (while local-extent-list + (setq extent (car local-extent-list)) + (if (or (extent-detached-p extent) + (and (<= (point-min)(extent-start-position extent)) + (>= (point-max)(extent-end-position extent)))) + (delete-extent extent) + (setq debian-changelog-ext-list + (cons extent debian-changelog-ext-list))) + (setq local-extent-list (cdr local-extent-list))) + ;; Remove properties for regular emacs + ;; FIXME This detroys all mouse-faces and local-maps! + (let ((before-change-functions) (after-change-functions)) + (remove-text-properties (point-min) (point-max) + '(mouse-face t local-map t)))) + (goto-char (point-min)) + ;; FIXME: Ideally, I want to hightlight _only_ the digit parts + ;; (skipping the coma, and the word "bug". + (while + (re-search-forward +;;; "\\(closes:\\) *\\(\\(bug\\)?#? *[0-9]+\\(, *\\(bug\\)?#? *[0-9]+\\)*\\)" + ;; Same deal as for font-lock - patch from Fred Bothamy. + "\\(closes:\\)[ \t\n]*\\(\\(bug\\)?#? *[0-9]+\\(,[ \t\n]*\\(bug\\)?#? *[0-9]+\\)*\\)" + nil t) + (setq s (match-beginning 2)) + (setq e (match-end 2)) + (cond + ((string-match "XEmacs\\|Lucid" emacs-version) + (setq extent (make-extent s e)) + (setq debian-changelog-ext-list + (cons extent debian-changelog-ext-list)) + (set-extent-property extent 'highlight t) + (set-extent-property extent 'start-open t) +; (set-extent-property extent 'balloon-help 'debian-changelog-label-help) +; (set-extent-property extent 'help-echo 'debian-changelog-label-help-echo) + (set-extent-property extent 'keymap debian-changelog-mouse-keymap)) + (t + (let ((before-change-functions) (after-change-functions)) + (put-text-property s e 'local-map + debian-changelog-mouse-keymap) + (put-text-property s e 'mouse-face 'highlight))))) + (set-buffer-modified-p modified)))) + +;;;------------- +;;; imenu stuff - Peter Galbraith, May 2001 + +(eval-when-compile + (require 'cl) + (if (fboundp 'imenu) ;Make sure auto-load is loaded + (require 'imenu))) + +(defvar debian-changelog-imenu-doing-closebug nil + "Internal flag set when imenu is processing many bug closings.") +(make-variable-buffer-local 'debian-changelog-imenu-doing-closebug) + +(defun debian-changelog-imenu-prev-index-position-function () + (cond + (debian-changelog-imenu-doing-closebug + (if (not (posix-search-backward + "\\(closes:\\)\\|[^0-9]\\([0-9]+\\)" nil t)) + nil ; No match + ;; match 1 -> "closes:" + ;; match 2 -> a bug number + (cond + ((match-string 1) + (setq debian-changelog-imenu-doing-closebug nil) + (debian-changelog-imenu-prev-index-position-function)) + (t + ;; Return the bug number match + t)))) + (t + (if (not (re-search-backward + "\\(closes: *\\(bug\\)?#? *[0-9]+\\)\\|\\(^\\sw.* (\\(.+\\))\\)" + nil t)) + nil ; No match + ;; match 1 -> "closes:" + ;; match 4 -> a version number + (cond + ((match-string 1) + (setq debian-changelog-imenu-doing-closebug t) + (forward-char -1) + (re-search-forward + "\\(closes:\\) *\\(\\(bug\\)?#? *[0-9]+\\(, *\\(bug\\)?#? *[0-9]+\\)*\\)" + nil t) + (forward-char 1) + (debian-changelog-imenu-prev-index-position-function)) + (t + ;; Return the version number match + t)))))) + +(defvar debian-changelog-imenu-counter nil + "Debian-changelog-mode internal variable for imenu support.") + +(defun imenu--create-debian-changelog-index () + (save-match-data + (save-excursion + (let ((index-alist '()) + (index-bug-alist '()) + (index-bugsorted-alist '()) + (prev-pos 0) + (imenu-scanning-message "Scanning changelog for History (%3d%%)") + ) + (setq debian-changelog-imenu-counter -99) + (goto-char (point-max)) + (imenu-progress-message prev-pos 0 t) +;;; (message "Scanning changelog history...") + (setq debian-changelog-imenu-doing-closebug nil) + (while (debian-changelog-imenu-prev-index-position-function) + (imenu-progress-message prev-pos nil t) + (let ((marker (make-marker))) + (set-marker marker (point)) + (cond + ((match-beginning 2) ;bug number + (push (cons (match-string-no-properties 2) marker) + index-bug-alist)) + ((match-beginning 4) ;version number + (push (cons (match-string-no-properties 4) marker) + index-alist))))) + (imenu-progress-message prev-pos 100 t) +;;; (message "Scanning changelog history... done.") + (cond + (index-bug-alist + (push (cons "Closed Bugs (chrono)" + index-bug-alist) + index-alist) + (setq index-bugsorted-alist (copy-alist index-bug-alist)) + (push (cons "Closed Bugs (sorted)" + (sort index-bugsorted-alist + 'debian-changelog-imenu-sort)) + index-alist))) + index-alist)))) + +(defun debian-changelog-imenu-sort (el1 el2) + "Predicate to compare labels in lists." + (string< (car el2) (car el1) )) + +;;; end of imenu stuff +;;;------------- + +;;; Setup auto-mode-alist +;; (in case /etc/emacs/site-start.d/50dpkg-dev.el not used) +;; +;; Crib note: no need for "NEWS.Debian.gz" or "changelog.Debian.gz" entries +;; since jka-compr.el dispatches using the basename after uncompressing. + +(add-to-list 'auto-mode-alist '("/debian/*NEWS" . debian-changelog-mode)) +(add-to-list 'auto-mode-alist '("NEWS.Debian" . debian-changelog-mode)) + +;;(add-to-list 'auto-mode-alist '("/debian/changelog\\'" . debian-changelog-mode)) +;;; Instead use this. See http://bugs.debian.org/457047 by Trent W. Buck +;;; Valid package names spec is Debian Policy section 5.6.7 +(add-to-list + 'auto-mode-alist + '("/debian/\\([[:lower:][:digit:]][[:lower:][:digit:].+-]+\\.\\)?changelog\\'" + . debian-changelog-mode)) + +(add-to-list 'auto-mode-alist '("changelog.Debian" . debian-changelog-mode)) + ;; For debchange +(add-to-list 'auto-mode-alist '("changelog.dch" . debian-changelog-mode)) + +;;;###autoload(add-to-list 'auto-mode-alist '("/debian/*NEWS" . debian-changelog-mode)) +;;;###autoload(add-to-list 'auto-mode-alist '("NEWS.Debian" . debian-changelog-mode)) +;;;###autoload(add-to-list 'auto-mode-alist '("/debian/\\([[:lower:][:digit:]][[:lower:][:digit:].+-]+\\.\\)?changelog\\'" . debian-changelog-mode)) +;;;###autoload(add-to-list 'auto-mode-alist '("changelog.Debian" . debian-changelog-mode)) +;;;###autoload(add-to-list 'auto-mode-alist '("changelog.dch" . debian-changelog-mode)) + +(provide 'debian-changelog-mode) + +;;; debian-changelog-mode.el ends here diff --git a/elisp/dpkg-dev-el/debian-control-mode.el b/elisp/dpkg-dev-el/debian-control-mode.el new file mode 100755 index 0000000..d3936fe --- /dev/null +++ b/elisp/dpkg-dev-el/debian-control-mode.el @@ -0,0 +1,525 @@ +;;; debian-control-mode.el --- major mode for Debian control files + +;; Copyright (C) 2001, 2003 Free Software Foundation, Inc. +;; Copyright (C) 2003-2005, 2007-2011 Peter S Galbraith + +;; Author: Colin Walters +;; Maintainer: Peter S Galbraith +;; Created: 29 Nov 2001 +;; Version: 1.5 +;; X-RCS: $Id: debian-control-mode.el,v 1.19 2013/10/15 17:22:44 psg Exp $ +;; Keywords: convenience + +;; 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. +;; +;; debian-control-mode.el 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 your Debian installation, in /usr/share/common-licenses/GPL +;; If not, write to the Free Software Foundation, 675 Mass Ave, +;; Cambridge, MA 02139, USA. + +;;; Commentary: + +;; debian-control-mode.el is developed under Emacs 21, and is targeted +;; for use in Emacs 21 and relatively recent versions of XEmacs. + +;;; Change Log: + +;; V1.5 (2011-08-16) Added "Multi-Arch:" (Closes #634162) + +;; V1.4 (2011-06-24) Added "XS-Python-Version" to debian-control-source-fields +;; (Closes #591697) + +;; V1.3 (2010-05-07) Added "Breaks" to debian-control-binary-fields +;; (Closes #580501) + +;; V1.2a (2009-02-23) Applied patch from Morten Kjeldgaard changing +;; Dm-Upload-Allowed to DM-Upload-Allowed (Closes: #508748) + +;; V1.2 (2008-01-17) Cyril Brulebois +;; - Add "Dm-Upload-Allowed" field to source fields. + +;; V1.1 (2007-10-18) Cyril Brulebois +;; - Renamed "XS-Vcs-*" fields into "Vcs-*", officially supported since +;; dpkg/1.14.7. + +;; V1.0 (2007-10-01) Cyril Brulebois +;; - Add "Homepage" field to source fields. +;; - Add "XS-Vcs-*" fields to source fields, patch contributed by +;; Rafael Laboissiere (Closes: #422491). + +;; V0.9 (2005-11-22) Peter S Galbraith +;; - Make # the comment character. (Closes: #339868) + +;; V0.8 (2005-02-07) Peter S Galbraith +;; - Change mouse-2 binding to C-mouse-2 (Closes: #293629) +;; - Fix debian-control-mode-bugs-mouse-click to create correct +;; text-properties of package names. + +;; V0.7 (2004-03-27) Peter S Galbraith +;; +;; * Apply patch from Jhair Tocancipa Triana +;; in http://bugs.debian.org/226770. Fixes an after-change-functions race. + +;; V0.6 (2003-11-27) Peter S Galbraith +;; +;; * Only fontify known fields (to better catch misspellings) (Closes: #213779) +;; * Add "Uploaders" field; Add "Section" and "Priority" also to binary fields. +;; * Call `goto-address' in major-mode to clickify URLs. +;; * http://cvs.verbum.org/debian/debian-control-mode link removed. + +;; V0.5 (2003/10/16) Peter S Galbraith +;; +;; * Add "View upgrading-checklist" to control menu. +;; * Added debian-control-find-file to make this work on XEmacs. + +;; Changes from 0.3 to 0.4: +;; +;; * Don't depend on face properties to find names of packages. +;; * Use an after-change-function to put special text properties on, +;; instead of using font-lock to do it. That way they'll be added +;; regardless of the value of `font-lock-mode'. +;; * Fix up portable definition of `with-auto-compression-mode'. + +;; Changes from 0.2 to 0.3: +;; +;; * Fix bug in filling description lines. +;; * Clicking on a source or binary package name shows bugs for that +;; package. +;; * New function `debian-control-mode-add-field', bound to 'C-c C-a' +;; by default. +;; * New function `debian-control-visit-policy', bound to 'C-c C-p' +;; by default. +;; * New function `debian-control-view-package-bugs', bound to 'C-c C-b' +;; by default. +;; * Initial menu support. +;; * Initial customize support. +;; * Imenu support. +;; * Initial attempts at XEmacs support. +;; * Use the term "field" instead of "header". + +;; Changes from 0.1 to 0.2: +;; +;; * Tighten up regexps; whitespace before and after a field value is +;; insignificant. Also, package names may contain '+' and '.'. +;; * Add more comments for compliance with Emacs Lisp coding standards. +;; * Allow filling of a regular field to work. +;; * Provide `debian-control-mode'. + +;;; Bugs: + +;; Filling doesn't work on XEmacs. I have no idea why. +;; Mouse stuff doesn't work on XEmacs. +;; Emacs 20 isn't supported. + +;;; Code: + +(require 'easymenu) +(require 'font-lock) +(eval-when-compile + (require 'cl)) + +;; XEmacs compatibility +(eval-and-compile + (unless (fboundp 'line-beginning-position) + (defun line-beginning-position () + (save-excursion + (beginning-of-line) + (point)))) + (unless (fboundp 'line-end-position) + (defun line-end-position () + (save-excursion + (end-of-line) + (point)))) + (unless (fboundp 'match-string-no-properties) + (defalias 'match-string-no-properties 'match-string))) + +(defgroup debian-control nil "Debian control file maintenance" + :group 'tools) + +(defcustom debian-control-source-package-face 'font-lock-type-face + "The face to use for highlighting source package names." + :type 'face + :group 'debian-control) + +(defcustom debian-control-binary-package-face 'font-lock-variable-name-face + "The face to use for highlighting binary package names." + :type 'face + :group 'debian-control) + +(defvar debian-control-syntax-table nil + "Syntax table used in debian-control-mode buffers.") + +(if debian-control-syntax-table + () + (setq debian-control-syntax-table (make-syntax-table)) + ;; Support # style comments + (modify-syntax-entry ?# "<" debian-control-syntax-table) + (modify-syntax-entry ?\n "> " debian-control-syntax-table)) + +;; FIXME: As of policy 3.5.6.0, the allowed characters in a field name +;; are not specified. So we just go with "word constituent" or '-' +;; characters before a colon. +(defvar debian-control-field-regexp "^\\(\\(\\sw\\|-\\)+:\\)") +(defvar debian-control-package-name-regexp "\\([-a-zA-Z0-9+.]+?\\)") + +(defvar debian-control-mode-package-name-keymap (make-sparse-keymap)) + +;; An uptodate list can be found at: +;; http://svn.debian.org/wsvn/qa/trunk/pts/www/bin/common.py?op=file +(defvar debian-control-vcs-names + '("Arch" "Bzr" "Cvs" "Darcs" "Git" "Hg" "Mtn" "Svn") + "Valid VCS names for the Vcs-* field.") + +(defvar debian-control-source-fields + (append + '("Section" "Priority" "Maintainer" "Build-Depends" "Build-Depends-Indep" + "Build-Conflicts" "Build-Conflicts-Indep" "Standards-Version" "Uploaders" + "DM-Upload-Allowed" "Homepage" "Vcs-Browser" "XS-Python-Version") + (mapcar (lambda (elt) (concat "Vcs-" elt)) + debian-control-vcs-names)) + "Valid source package field names, collected from several policy sections.") + +(defvar debian-control-binary-fields + '("Section" "Priority" "Architecture" "Depends" "Conflicts" "Pre-Depends" + "Essential" "Provides" "Recommends" "Suggests" "Replaces" "Enhances" + "Description" "Breaks") + "Valid binary package field names, collected from several policy sections.") + +(defvar debian-control-source-fields-regexp + (concat + "^\\(" + (let ((max-specpdl-size 1000)) + (regexp-opt debian-control-source-fields t)) + "\\):") + "font-lock regexp matching known fields in the source section.") + +(defvar debian-control-binary-fields-regexp + (concat + "^\\(" + (let ((max-specpdl-size 1000)) + (regexp-opt debian-control-binary-fields t)) + "\\):") + "font-lock regexp matching known fields in the binary section.") + +(defvar debian-control-font-lock-keywords + `((,(concat "^\\(Source:\\)\\s-*" + debian-control-package-name-regexp + "\\s-*$") + (1 font-lock-keyword-face) + ,(list 2 + (if (featurep 'xemacs) + '(symbol-value debian-control-source-package-face) + '(list 'face debian-control-source-package-face)) + nil nil)) + ("^\\(Multi-Arch:\\)\\s-*\\(same\\|foreign\\|allowed\\)" + (1 font-lock-function-name-face) + (2 font-lock-keyword-face)) + (,debian-control-source-fields-regexp + (1 font-lock-keyword-face)) + (,debian-control-binary-fields-regexp + (1 font-lock-function-name-face)))) + +(defvar debian-control-mode-menu nil) + +;;;###autoload +(define-derived-mode debian-control-mode fundamental-mode "Debian Control" + "A major mode for editing Debian control files (i.e. debian/control)." + (if (< emacs-major-version 21) + (message "debian-control-mode only supports emacsen version >= 21; disabling features") + (progn + (set-syntax-table debian-control-syntax-table) + ;; Comments + (make-local-variable 'comment-start-skip) ;Need this for font-lock... + (setq comment-start-skip "\\(^\\|\\s-\\);?#+ *") ;;From perl-mode + (make-local-variable 'comment-start) + (make-local-variable 'comment-end) + (setq comment-start "#" + comment-end "") + + (make-local-variable 'font-lock-defaults) + (setq font-lock-defaults + '(debian-control-font-lock-keywords + nil ;;; Keywords only? No, let it do syntax via table. + nil ;;; case-fold? + nil ;;; Local syntax table. + nil ;;; Use `backward-paragraph' ? No + )) + (set (make-local-variable 'fill-paragraph-function) + #'debian-control-mode-fill-paragraph) + (make-local-variable 'after-change-functions) + (push 'debian-control-mode-after-change-function after-change-functions) + (set (make-local-variable 'imenu-generic-expression) + '((nil "^\\(Package\\|Source\\):\\s-*\\([-a-zA-Z0-9+.]+?\\)\\s-*$" 2))) + + (define-key debian-control-mode-map (kbd "C-c C-b") 'debian-control-view-package-bugs) + (define-key debian-control-mode-map (kbd "C-c C-p") 'debian-control-visit-policy) + (define-key debian-control-mode-map (kbd "C-c C-a") 'debian-control-mode-add-field) + (define-key debian-control-mode-package-name-keymap (if (featurep 'xemacs) + [(control down-mouse-2)] + [(C-mouse-2)]) + 'debian-control-mode-bugs-mouse-click) + (easy-menu-add debian-control-mode-menu) + (if (and (featurep 'goto-addr) goto-address-highlight-p) + (goto-address)) + (let ((after-change-functions nil)) + (debian-control-mode-after-change-function (point-min) (point-max) 0))))) + +(defun debian-control-mode-after-change-function (beg end len) + (save-excursion + (let ((modified (buffer-modified-p)) + (buffer-read-only nil) + (data (match-data))) + (unwind-protect + (progn + (goto-char beg) + (beginning-of-line) + (while (< (point) end) + (cond ((looking-at (concat "^\\(Source:\\)\\s-*" + debian-control-package-name-regexp + "\\s-*$")) + (add-text-properties + (match-beginning 2) (match-end 2) + `(mouse-face + highlight + debian-control-mode-package ,(match-string 2) + help-echo "C-mouse-2: View bugs for this source package" + keymap ,debian-control-mode-package-name-keymap))) + ((looking-at (concat "^\\(Package:\\)\\s-*" + debian-control-package-name-regexp + "\\s-*$")) + (add-text-properties + (match-beginning 2) (match-end 2) + `(mouse-face + highlight + debian-control-mode-package ,(match-string 2) + help-echo "C-mouse-2: View bugs for this binary package" + keymap ,debian-control-mode-package-name-keymap))) + (t nil)) + (forward-line 1))) + (set-match-data data) + (set-buffer-modified-p modified))))) + +(easy-menu-define + debian-control-mode-menu debian-control-mode-map "Debian Control Mode Menu" + '("Control" + ["Add field at point" debian-control-mode-add-field t] + "--" + "Policy" + ["View upgrading-checklist" (debian-control-visit-policy 'checklist) + (file-exists-p "/usr/share/doc/debian-policy/upgrading-checklist.txt.gz")] + ["View policy (text)" (debian-control-visit-policy 'text) + (file-exists-p "/usr/share/doc/debian-policy/policy.txt.gz")] + ["View policy (HTML)" (debian-control-visit-policy 'html) t] + "--" + "Access www.debian.org" + ["Bugs for package" debian-control-view-package-bugs t] + ["Specific bug number" (debian-changelog-web-bug) nil] +;; ["Package list (all archives)" (debian-changelog-web-packages) t] +;; ("Package web pages..." +;; ["stable" (debian-changelog-web-package "stable") t] +;; ["testing" (debian-changelog-web-package "testing") t] +;; ["unstable" (debian-changelog-web-package "unstable") t]) + "--" + ["Customize" (customize-group "debian-control") t])) + +(defun debian-control-mode-fill-paragraph (&rest args) + (let (beg end) + (save-excursion + ;; Are we looking at a field? + (if (save-excursion + (beginning-of-line) + (looking-at debian-control-field-regexp)) + (setq beg (match-end 0) + end (line-end-position)) + ;; Otherwise, we're looking at a description; handle filling + ;; areas separated with "." specially + (setq beg (save-excursion + (beginning-of-line) + (while (not (or (bobp) + (looking-at "^\\sw-*$") + (looking-at "^ \\.") + (looking-at debian-control-field-regexp))) + (forward-line -1)) + (unless (eobp) + (forward-line 1)) + (point)) + end (save-excursion + (beginning-of-line) + (while (not (or (eobp) + (looking-at "^\\sw-*$") + (looking-at debian-control-field-regexp) + (looking-at "^ \\."))) + (forward-line 1)) + (unless (bobp) + (forward-line -1) + (end-of-line)) + (point)))) + (let ((fill-prefix " ")) + (apply #'fill-region beg end args))))) + +(defun debian-control-mode-add-field (binary field) + "Add a field FIELD to the current package; BINARY means a binary package." + (interactive + (let* ((binary-p (if (or (save-excursion + (beginning-of-line) + (looking-at "^\\(Package\\|Source\\)")) + (re-search-backward "^\\(Package\\|Source\\)" nil t)) + (not (not (string-match "Package" (match-string 0)))) + (error "Couldn't find Package or Source field"))) + (fields (if binary-p + debian-control-binary-fields + debian-control-source-fields)) + (completion-ignore-case t)) + (list + binary-p + (completing-read (format "Add %s package field: " (if binary-p "binary" "source")) + (mapcar #'(lambda (x) (cons x nil)) fields))))) + (require 'cl) + (let ((fields (if binary + debian-control-binary-fields + debian-control-source-fields)) + (beg (save-excursion + (beginning-of-line) + (while (not (or (bobp) + (looking-at "^\\s-*$"))) + (forward-line -1)) + (forward-line 1) + (point))) + (end (save-excursion + (beginning-of-line) + (while (not (or (eobp) + (looking-at "^\\s-*$"))) + (forward-line 1)) + (point)))) + (save-restriction + (narrow-to-region beg end) + (let ((curfields (let ((result nil)) + (goto-char (point-min)) + (while (not (eobp)) + (when (looking-at debian-control-field-regexp) + (push (cons (subseq + ;; Text properties are evil + (match-string-no-properties 1) + 0 + ;; Strip off the ':' + (- (match-end 1) + (match-beginning 1) + 1)) + (match-beginning 0)) + result)) + (forward-line 1)) + result)) + (x nil)) + ;; If the field is already present, just jump to it + (if (setq x (assoc field curfields)) + (goto-char (cdr x)) + (let* ((pos (or (position field fields :test #'string-equal) + -1)) + (prevfields (reverse (subseq fields 0 pos))) + (nextfields (subseq fields (1+ pos)))) + (if (not (wholenump pos)) + (goto-char (cdar curfields)) + (when prevfields + (while (and (car prevfields) + (not (assoc (car prevfields) curfields))) + (pop prevfields)) + (goto-char (cdr (assoc (car prevfields) curfields))) + (setq prevfields nil nextfields nil)) + (when nextfields + (while (and (car nextfields) + (not (assoc (car nextfields) curfields))) + (pop nextfields)) + (goto-char (cdr (assoc (car nextfields) curfields))) + (setq prevfields nil nextfields nil))) + ;; Hack: we don't want to add fields after Description + (beginning-of-line) + (when (looking-at "^Description") + (forward-line -1)) + (end-of-line) + (insert "\n" (upcase-initials field) ": "))))))) + +(defun debian-control-visit-policy (format) + "Visit the Debian Policy manual in format FORMAT. +Currently valid FORMATs are `html', `text' and `checklist'. +The last one is not strictly a format, but visits the upgrading-checklist.txt +text file." + (interactive + (list (intern + (completing-read "Policy format: " + (mapcar #'(lambda (x) (cons x 0)) + '("html" "text" "checklist")) + nil t)))) + (case format + (text + (debian-control-find-file "/usr/share/doc/debian-policy/policy.txt.gz")) + (checklist + (debian-control-find-file + "/usr/share/doc/debian-policy/upgrading-checklist.txt.gz")) + (html + (require 'browse-url) + (browse-url + (if (file-exists-p "/usr/share/doc/debian-policy/policy.html/index.html") + "file:///usr/share/doc/debian-policy/policy.html/index.html" + (prog1 + "http://www.debian.org/doc/debian-policy" + (message "Note: package `debian-policy' not installed, using web version"))))) + (t + (error "Unknown format %s for policy" format)))) + +(defun debian-control-find-file (file) + "Find-file a possibly compressed FILE" + (require 'jka-compr) + (let ((installed (jka-compr-installed-p))) + (if (not installed) + (auto-compression-mode t)) + (find-file file) + (if (not installed) + (auto-compression-mode -1)))) + +(defun debian-control-mode-bugs-mouse-click (event) + "Display the bugs for the package name clicked on." + (interactive "e") + (mouse-set-point event) + (let ((prop (get-text-property (point) 'debian-control-mode-package))) + (unless prop + (error "Couldn't determine package name at point")) + (debian-control-view-package-bugs prop))) + +(defun debian-control-mode-bug-package-names () + (let ((result nil)) + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (when (looking-at "^\\(Package\\|Source\\):\\s-*\\([-a-zA-Z0-9+.]+?\\)\\s-*$") + (push (concat + (if (save-match-data (string-match "Source" (match-string 1))) + "src:" + "") + (match-string-no-properties 2)) result)) + (forward-line 1))) + result)) + +(defun debian-control-view-package-bugs (package) + "View bugs for package PACKAGE via http://bugs.debian.org." + (interactive + (list + (completing-read "View bugs for package: " + (mapcar #'(lambda (x) (cons x 0)) + (debian-control-mode-bug-package-names)) + nil t))) + (browse-url (concat "http://bugs.debian.org/" package))) + +(add-to-list 'auto-mode-alist '("/debian/control\\'" . debian-control-mode)) +;;;###autoload(add-to-list 'auto-mode-alist '("/debian/control\\'" . debian-control-mode)) + +(provide 'debian-control-mode) + +;;; debian-control-mode.el ends here diff --git a/elisp/dpkg-dev-el/debian-copyright.el b/elisp/dpkg-dev-el/debian-copyright.el new file mode 100755 index 0000000..4de8a98 --- /dev/null +++ b/elisp/dpkg-dev-el/debian-copyright.el @@ -0,0 +1,97 @@ +;;; debian-copyright.el --- Major mode for Debian package copyright files + +;; Copyright 2002, 2003 Junichi Uekawa. + +;; 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. +;; +;; debian-copyright.el 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 your Debian installation, in /usr/share/common-licenses/GPL +;; If not, write to the Free Software Foundation, 675 Mass Ave, +;; Cambridge, MA 02139, USA. + + +(require 'debian-changelog-mode) + +;;; Code: + +(defgroup debian-copyright nil "Debian copyright mode" + :group 'tools + :prefix "debian-copyright-") + +(defcustom debian-copyright-mode-load-hook nil + "*Hooks that are run when `debian-copyright-mode' is loaded." + :group 'debian-copyright + :type 'hook) + +(defcustom debian-copyright-mode-hook nil + "Normal hook run when entering Debian Copyright mode." + :group 'debian-copyright + :type 'hook + :options '(turn-on-auto-fill flyspell-mode)) + +(defconst debian-copyright-mode-version "$Id: debian-copyright.el,v 1.5 2010-07-28 15:33:45 psg Exp $" "Version of debian copyright mode.") + +(defvar debian-copyright-mode-map nil + "Keymap for debian/copyright mode.") +(defvar debian-copyright-mode-syntax-table nil + "Syntax table for debian/copyright mode.") + +(defvar debian-copyright-font-lock-keywords nil + "Regexps to highlight in font-lock.") + +(if debian-copyright-mode-syntax-table + () ; Do not change the table if it is already set up. + (setq debian-copyright-mode-syntax-table (make-syntax-table)) + (modify-syntax-entry ?\" ". " debian-copyright-mode-syntax-table) + (modify-syntax-entry ?\\ ". " debian-copyright-mode-syntax-table) + (modify-syntax-entry ?' "w " debian-copyright-mode-syntax-table)) + +;;;###autoload +(defun debian-copyright-mode () + "Mode to edit and read debian/copyright. +\\{debian-copyright-mode-map}" + (interactive) + (kill-all-local-variables) + (setq major-mode 'debian-copyright-mode) + (setq mode-name "debian/copyright") + (mapcar 'make-local-variable '(font-lock-defaults write-file-hooks)) + (use-local-map debian-copyright-mode-map) + (set-syntax-table debian-copyright-mode-syntax-table) + (if (or (not (featurep 'goto-addr)) + (not goto-address-highlight-p)) + (setq debian-copyright-font-lock-keywords + '(("http:.*$" . font-lock-function-name-face) + ("ftp:.*$" . font-lock-function-name-face) + ("^Copyright:$" . font-lock-keyword-face))) + (setq debian-copyright-font-lock-keywords + '(("^Copyright:$" . font-lock-keyword-face))) + (goto-address)) + (setq font-lock-defaults + '(debian-copyright-font-lock-keywords + nil ;keywords-only + nil ;case-fold + () ;syntax-alist + )) + (run-hooks 'debian-copyright-mode-hook)) + + +;;;###autoload +(add-to-list 'auto-mode-alist + '("debian/.*copyright\\'" . debian-copyright-mode)) +;;;###autoload +(add-to-list 'auto-mode-alist + '("\\`/usr/share/doc/.*/copyright" . debian-copyright-mode)) + +(run-hooks 'debian-copyright-mode-load-hook) + +(provide 'debian-copyright) + +;;; debian-copyright.el ends here diff --git a/elisp/dpkg-dev-el/dpkg-dev-el-loaddefs.el b/elisp/dpkg-dev-el/dpkg-dev-el-loaddefs.el new file mode 100755 index 0000000..40ccb19 --- /dev/null +++ b/elisp/dpkg-dev-el/dpkg-dev-el-loaddefs.el @@ -0,0 +1,116 @@ +;;; dpkg-dev-el-loaddefs.el --- automatically extracted autoloads +;; +;;; Code: + +(provide 'dpkg-dev-el-loaddefs) + +;;;### (autoloads (emacs-bts-control debian-bts-control) "debian-bts-control" +;;;;;; "debian-bts-control.el" (19331 13289)) +;;; Generated autoloads from debian-bts-control.el + +(autoload 'debian-bts-control "debian-bts-control" "\ +Contruct a message with initial ACTION command for control@bugs.debian.org. +Contructs a new control command line if called from within the message +being constructed. + +If prefix arg is provided, use the current buffer instead instead of +creating a new outgoing email message buffer. +The current buffer is also used if the current major mode matches one listed +in `debian-bts-control-modes-to-reuse'. + +\(fn ACTION &optional ARG)" t nil) + +(autoload 'emacs-bts-control "debian-bts-control" "\ +Contruct a message with ACTION command for control@debbugs.gnu.org. +Contructs a new control command line if called from within the message +being constructed. + +If prefix arg is provided, use the current buffer instead instead of +creating a new outgoing email message buffer. +The current buffer is also used if the current major mode matches one listed +in `debian-bts-control-modes-to-reuse'. + +\(fn ACTION &optional ARG)" t nil) + +;;;*** + +;;;### (autoloads (debian-changelog-mode debian-changelog-add-entry) +;;;;;; "debian-changelog-mode" "debian-changelog-mode.el" (19196 +;;;;;; 33072)) +;;; Generated autoloads from debian-changelog-mode.el + +(autoload 'debian-changelog-add-entry "debian-changelog-mode" "\ +Add a new change entry to a debian-style changelog. +If called from buffer other than a debian/changelog, this will search +for the debian/changelog file to add the entry to. + +\(fn)" t nil) + +(autoload 'debian-changelog-mode "debian-changelog-mode" "\ +Major mode for editing Debian-style change logs. +Runs `debian-changelog-mode-hook' if it exists. + +Key bindings: + +\\{debian-changelog-mode-map} + +If you want to use your debian.org email address for debian/changelog +entries without using it for the rest of your email, use the `customize` +interface to set it, or simply set the variable +`debian-changelog-mailing-address' in your ~/.emacs file, e.g. + + (setq debian-changelog-mailing-address \"myname@debian.org\")) + +\(fn)" t nil) +(add-to-list 'auto-mode-alist '("/debian/*NEWS" . debian-changelog-mode)) +(add-to-list 'auto-mode-alist '("NEWS.Debian" . debian-changelog-mode)) +(add-to-list 'auto-mode-alist '("NEWS.Debian.gz" . debian-changelog-mode)) +(add-to-list 'auto-mode-alist '("/debian/\\([[:lower:][:digit:]][[:lower:][:digit:].+-]+\\.\\)?changelog\\'" . debian-changelog-mode)) +(add-to-list 'auto-mode-alist '("changelog.Debian" . debian-changelog-mode)) +(add-to-list 'auto-mode-alist '("changelog.Debian.gz" . debian-changelog-mode)) +(add-to-list 'auto-mode-alist '("changelog.dch" . debian-changelog-mode)) + +;;;*** + +;;;### (autoloads (debian-control-mode) "debian-control-mode" "debian-control-mode.el" +;;;;;; (18850 58753)) +;;; Generated autoloads from debian-control-mode.el + +(autoload 'debian-control-mode "debian-control-mode" "\ +A major mode for editing Debian control files (i.e. debian/control). + +\(fn)" t nil) +(add-to-list 'auto-mode-alist '("/debian/control\\'" . debian-control-mode)) + +;;;*** + +;;;### (autoloads (debian-copyright-mode) "debian-copyright" "debian-copyright.el" +;;;;;; (16295 49413)) +;;; Generated autoloads from debian-copyright.el + +(autoload (quote debian-copyright-mode) "debian-copyright" "\ +Mode to edit and read debian/copyright. +\\{debian-copyright-mode-map}" t nil) +(add-to-list 'auto-mode-alist '("debian/.*copyright$" . debian-copyright-mode)) +(add-to-list 'auto-mode-alist '("^/usr/share/doc/.*/copyright" . debian-copyright-mode)) + +;;;*** + +;;;### (autoloads nil nil ("dpkg-dev-el.el") (19331 13614 16291)) + +;;;*** + +;;;### (autoloads (readme-debian-mode) "readme-debian" "readme-debian.el" +;;;;;; (17503 21939)) +;;; Generated autoloads from readme-debian.el + +(autoload (quote readme-debian-mode) "readme-debian" "\ +Mode for reading and editing README.Debian files. +Upon saving the visited README.Debian file, the timestamp at the bottom +will be updated. + +\\{readme-debian-mode-map}" t nil) +(add-to-list 'auto-mode-alist '("debian/.*README.*Debian$" . readme-debian-mode)) +(add-to-list 'auto-mode-alist '("^/usr/share/doc/.*/README.*Debian.*$" . readme-debian-mode)) + +;;;*** diff --git a/elisp/dpkg-dev-el/dpkg-dev-el-loaddefs.make b/elisp/dpkg-dev-el/dpkg-dev-el-loaddefs.make new file mode 100755 index 0000000..fffbdcd --- /dev/null +++ b/elisp/dpkg-dev-el/dpkg-dev-el-loaddefs.make @@ -0,0 +1 @@ +emacs -batch --no-site-file --multibyte --eval '(setq load-path (cons "." load-path))' -l autoload --eval '(setq generated-autoload-file (expand-file-name "dpkg-dev-el-loaddefs.el"))' --eval '(setq make-backup-files nil)' -f batch-update-autoloads . diff --git a/elisp/dpkg-dev-el/dpkg-dev-el.el b/elisp/dpkg-dev-el/dpkg-dev-el.el new file mode 100755 index 0000000..b465cfc --- /dev/null +++ b/elisp/dpkg-dev-el/dpkg-dev-el.el @@ -0,0 +1,106 @@ +;;; dpkg-dev-el.el --- startup file for the debian-el package + +;;; Commentary: +;; +;; This file is loaded from /etc/emacs/site-start.d/50dpkg-dev-el.el + +;;; History: +;; +;; 2003-11-03 - Peter Galbraith +;; - Created. + +;;; Code: + +(defgroup dpkg-dev-el nil + "Emacs helpers specific to Debian development." + :group 'convenience) + +(require 'dpkg-dev-el-loaddefs) + +;; debian-bts-control +(defgroup debian-bts-control nil + "Create messages for Debian BTS control interface" + :group 'debian-bug +;;:link '(custom-manual "(dpkg-dev-el)debian-bts-control") + :load 'debian-bts-control + :group 'dpkg-dev-el) + +;; debian-changelog-mode +(defgroup debian-changelog nil "Debian changelog maintenance" + :group 'tools + :prefix "debian-changelog-" +;;:link '(custom-manual "(dpkg-dev-el)debian-changelog-mode") + :load 'debian-changelog-mode + :group 'dpkg-dev-el) + +;; debian-control-mode +(defgroup debian-control nil "Debian control file maintenance" + :link '(url-link "http://cvs.verbum.org/debian/debian-control-mode") + :group 'tools +;;:link '(custom-manual "(dpkg-dev-el)debian-control-mode") + :load 'debian-control-mode + :group 'dpkg-dev-el) + +;; debian-copyright +(defgroup debian-copyright nil "Debian copyright mode" + :group 'tools + :prefix "debian-copyright-" +;;:link '(custom-manual "(dpkg-dev-el)debian-copyright") + :load 'debian-copyright + :group 'dpkg-dev-el) + +;; readme-debian +(defgroup readme-debian nil "Readme Debian (mode)" + :group 'tools + :prefix "readme-debian-" +;;:link '(custom-manual "(dpkg-dev-el)readme-debian") + :load 'readme-debian + :group 'dpkg-dev-el) + + + + +;; other useful automode +(add-to-list 'auto-mode-alist + '("/debian/[^/]*emacsen-startup\\'" . emacs-lisp-mode)) +;; Closes #490292 +(add-to-list 'auto-mode-alist '("README.source" . readme-debian-mode)) + +(when (member 'utf-8 (coding-system-list)) + ;; default to utf-8 for debian changelog files + (modify-coding-system-alist 'file "/changelog\\.Debian\\'" 'utf-8) + (modify-coding-system-alist 'file "/debian/control\\'" 'utf-8) + +;;; (modify-coding-system-alist 'file "/debian/changelog\\'" 'utf-8) +;;; - +;;; Kevin Ryde (Closes: #587921) +;;; +;;; Instead use this for dh_installchangelog debian/packagename.changelog +;;; files too. See http://bugs.debian.org/457047 by Trent W. Buck +;;; But not [:lower:][:digit:] since those forms are not available in xemacs21. +;;; xemacs21 can have utf-8 at startup if you use mule-ucs with +;;; DEB_MULEUCS_UNICODE=yes + (modify-coding-system-alist 'file "/debian/\\([a-z0-9.+-]+\\.\\)?changelog\\'" 'utf-8) + + ;; Handle Debian native package, from Kevin Ryde in bug #317597 and #416218 + (defun debian-changelog-coding-system (args) + "Return the coding system for a /usr/share/doc/[package]/changelog file. +If [package] is a debian native (no separate changelog.Debian) then answer +`utf-8', otherwise remove ourselves from `file-coding-system-alist' and see +what other rules say." + (let ((filename (if (consp (cadr args)) + (car (cadr args)) ;; ("filename" . buffer) in emacs 22 + (cadr args))) ;; "filename" in emacs 21 + (dirname (file-name-directory filename))) + (if (file-exists-p (concat dirname "changelog.Debian.gz")) + (let ((file-coding-system-alist + (remove '("/usr/share/doc/[^/]+/changelog\\'" + . debian-changelog-coding-system) + file-coding-system-alist))) + (apply 'find-operation-coding-system args)) + 'utf-8)))) + + +(provide 'dpkg-dev-el) + +;;; dpkg-dev-el.el ends here diff --git a/elisp/dpkg-dev-el/readme-debian.el b/elisp/dpkg-dev-el/readme-debian.el new file mode 100755 index 0000000..f400028 --- /dev/null +++ b/elisp/dpkg-dev-el/readme-debian.el @@ -0,0 +1,126 @@ +;;; readme-debian.el --- a simple mode for README.Debian files + +;; Copyright 2002, 2003, 2006 Junichi Uekawa. +;; +;; 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. +;; +;; readme-debian.el 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 your Debian installation, in /usr/share/common-licenses/GPL +;; If not, write to the Free Software Foundation, 675 Mass Ave, +;; Cambridge, MA 02139, USA. + +;;; Code: +(require 'debian-changelog-mode) +(defgroup readme-debian nil "Readme Debian (mode)" + :group 'tools + :prefix "readme-debian-") + +(defcustom readme-debian-mode-load-hook nil "*Hooks that are run when `readme-debian-mode' is loaded." + :type 'hook + :group 'readme-debian) +(defcustom readme-debian-mode-hook nil "*Hooks that are run when `readme-debian-mode' is entered." + :type 'hook + :group 'readme-debian) + +(defvar readme-debian-font-lock-keywords + '(("^\\(.*\\) for \\(Debian\\)$" + (1 font-lock-keyword-face) + (2 font-lock-string-face)) + ("^[-=]+$" 0 font-lock-string-face) + ("^ -- \\([^<]*\\)\\(<[^>]*>\\)\\(, \\(.*\\)\\)?$" + (1 font-lock-keyword-face) + (2 font-lock-function-name-face) + (3 font-lock-string-face))) + "Regexp keywords used to fontify README.Debian buffers.") + +(defun readme-debian-date-string () + "Return RFC-822 format date string." + ;; this function could be simpler if xemacs supported %z, but + ;; it doesn't, so we're shelling out to invoke date -R to obtain + ;; Debian-policy-compliant date string. + (let* ((date-program "date -R") + (system-time-locale "C")) + (if (featurep 'xemacs) + (replace-in-string (exec-to-string date-program) "\n" "") + ;; if it's not xemacs, just use format-time-string + (format-time-string "%a, %e %b %Y %T %z" (current-time))))) + +(defun readme-debian-update-timestamp () + "Function to update timestamp in README.Debian files, automatically invoked when saving file." + (save-excursion + (goto-line 1) + (if (re-search-forward "^ -- " nil t) + (delete-region (progn (beginning-of-line) (point)) (progn (end-of-line) (point))) + (goto-char (point-max)) + (if (bolp) + (insert "\n") + (insert "\n\n"))) + (insert (concat + " -- " + debian-changelog-full-name + " <" debian-changelog-mailing-address ">, " + (readme-debian-date-string))) + (if (and (= (point)(point-max)) (not (bolp))) + (insert "\n")))) + +(defvar readme-debian-mode-map nil "Keymap for README.Debian mode.") +(if readme-debian-mode-map + () + (setq readme-debian-mode-map (make-sparse-keymap))) +(defvar readme-debian-mode-syntax-table nil "Syntax table for README.Debian mode.") +(if readme-debian-mode-syntax-table + () ; Do not change the table if it is already set up. + (setq readme-debian-mode-syntax-table (make-syntax-table)) + (modify-syntax-entry ?\" ". " readme-debian-mode-syntax-table) + (modify-syntax-entry ?\\ ". " readme-debian-mode-syntax-table) + (modify-syntax-entry ?' "w " readme-debian-mode-syntax-table)) + +(defvar font-lock-defaults) ;For XEmacs byte-compilation +;;;###autoload +(defun readme-debian-mode () + "Mode for reading and editing README.Debian files. +Upon saving the visited README.Debian file, the timestamp at the bottom +will be updated. + +\\{readme-debian-mode-map}" + (interactive) + (kill-all-local-variables) + (setq major-mode 'readme-debian-mode) + (setq mode-name "README.Debian") + (make-local-variable 'font-lock-defaults) + (use-local-map readme-debian-mode-map) + (set-syntax-table readme-debian-mode-syntax-table) + (setq font-lock-defaults + '(readme-debian-font-lock-keywords + nil ;; keywords-only? No, let it do syntax via table. + nil ;; case-fold? + nil ;; Local syntax table. + )) + ;; add timestamp update func to write-contents-hooks + (if (or (= emacs-major-version 20) + (string-match "XEmacs" emacs-version)) + (make-local-hook 'write-contents-hooks)) + (add-hook 'write-contents-hooks 'readme-debian-update-timestamp + nil t) + (run-hooks 'readme-debian-mode-hook)) + +(add-to-list 'auto-mode-alist + '("debian/.*README.*Debian$" . readme-debian-mode)) +(add-to-list 'auto-mode-alist + '("^/usr/share/doc/.*/README.*Debian.*$" . readme-debian-mode)) +;;;###autoload(add-to-list 'auto-mode-alist '("debian/.*README.*Debian$" . readme-debian-mode)) +;;;###autoload(add-to-list 'auto-mode-alist '("^/usr/share/doc/.*/README.*Debian.*$" . readme-debian-mode)) + +(run-hooks 'readme-debian-mode-load-hook) + +(provide 'readme-debian) + +;;; readme-debian.el ends here diff --git a/elisp/emacs-goodies-el/align-string.el b/elisp/emacs-goodies-el/align-string.el new file mode 100755 index 0000000..c06ba41 --- /dev/null +++ b/elisp/emacs-goodies-el/align-string.el @@ -0,0 +1,100 @@ +;;; align-string.el --- align string components over several lines + +;; Copyright (c) 2001 Markus Bjartveit Krger + +;; Author: Markus Bjartveit Krger +;; Created: 20-Sep-2001 +;; Version: 0.1 +;; Keywords: convenience +;; X-URL: http://www.pvv.org/~markusk/align-string.el + +;; 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: + +;;;###autoload +(defun align-string (begin end regexp count) + "Align first occurrence of REGEXP in each line of region. +If given a prefix argument, align occurrence number COUNT on each line." + (interactive "r +sAlign by: +p") + (undo-boundary) + (save-excursion + ;; Move begin point to start of line. + (goto-char begin) + (setq begin (line-beginning-position)) + ;; Make end a marker, to track updates made in buffer. Point the + ;; marker at the end of the last line, unless at start of line. + (goto-char end) + (setq end (set-marker (make-marker) (if (bolp) + (point) + (line-end-position)))) + (let ((max-col 0)) + ;; Find max column of first occurrence of string in the lines + ;; bounded by begin-marker and end-marker + (goto-char begin) + (while (< (point) end) + (when (re-search-forward regexp (line-end-position) t count) + (goto-char (match-beginning 0)) + (setq max-col (max max-col (current-column)))) + (beginning-of-line 2)) + ;; For each line in region, indent first occurrence of string + ;; to max column. + (goto-char begin) + (while (< (point) end) + (when (re-search-forward regexp (line-end-position) t count) + (goto-char (match-beginning 0)) + (indent-to max-col)) + (beginning-of-line 2))) + ;; Clear end marker. + (set-marker end nil))) + +;;;###autoload +(defun align-all-strings (begin end regexp) + "Align all occurrences of REGEXP in each line of region. +That is to say, align the first occurrence of each line with each other, +align the second occurence of each line with each other, and so on." + (interactive "r +sAlign by: ") + (save-excursion + ;; Move begin point to start of line. + (goto-char begin) + (setq begin (line-beginning-position)) + ;; Make end a marker, to track updates made in buffer. Point the + ;; marker at the end of the last line. + (goto-char end) + (setq end (set-marker (make-marker) (if (bolp) + (point) + (line-end-position)))) + ;; Count max number of occurrences in any line in region, then + ;; run align-string for each enumerated occurrence. + (let ((max-occs 0)) + (goto-char begin) + (while (< (point) end) + (let ((occs-this-line 0) + (line-end (line-end-position))) + (while (and (< (point) line-end) + (re-search-forward regexp line-end t)) + (setq occs-this-line (1+ occs-this-line)) + ; Ensure that search moves forward even if match is empty + (when (= (match-beginning 0) (point)) + (forward-char))) + (setq max-occs (max max-occs occs-this-line))) + (beginning-of-line 2)) + (let ((i 1)) + (while (<= i max-occs) + (align-string begin end regexp i) + (setq i (1+ i))))) + ;; Clear end marker. + (set-marker end nil))) diff --git a/elisp/emacs-goodies-el/all.el b/elisp/emacs-goodies-el/all.el new file mode 100755 index 0000000..f9d1aa0 --- /dev/null +++ b/elisp/emacs-goodies-el/all.el @@ -0,0 +1,228 @@ +;;; all.el --- Edit all lines matching a given regexp. + +;; Copyright (C) 1985, 1986, 1987, 1992, 1994 Free Software Foundation, Inc. +;; Copyright (C) 1994 Per Abrahamsen + +;; Author: Per Abrahamsen +;; Version: $Id: all.el,v 1.2 2003-05-09 16:22:59 psg Exp $ +;; Keywords: matching + +;; LCD Archive Entry: +;; all|Per Abrahamsen|abraham@dina.kvl.dk| +;; Edit all lines matching a given regexp| +;; $Date: 2003-05-09 16:22:59 $|$Revision: 1.2 $|~/misc/all.Z| + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +;;; Comments: + +;; Just like occur, except that changes in the *All* buffer is +;; propagated to the original buffer. + +;; I also added highlighting of the matches. + +;; You can no longer use mouse-2 to find a match in the original file, +;; since the default definition of mouse to is useful. +;; However, `C-c C-c' still works. + +;; Line numbers are not listed in the *All* buffer. + +;; Ok, it is _not_ just like occur. + +;; Some limitations: + +;; - Undo in the *All* buffer is an ordinary change in the original. +;; - Changes to the original buffer is not reflected in the *All* buffer. +;; - A single change in the *All* buffer must be limited to a single match. + +;; Requires GNU Emacs 19.23 or later. + +;;; Code: + +(defvar all-mode-map ()) + +(if all-mode-map + () + (setq all-mode-map (make-sparse-keymap)) + (define-key all-mode-map "\C-c\C-c" 'all-mode-goto)) + +(defvar all-buffer nil) + +(defun all-mode () + "Major mode for output from \\[all]. + +All changes made in this buffer will be propagated to the buffer where +you ran \\[all]. + +Press \\[all-mode-goto] to go to the same spot in the original buffer." + (kill-all-local-variables) + (use-local-map all-mode-map) + (setq major-mode 'all-mode) + (setq mode-name "All") + (make-local-variable 'all-buffer) + (run-hooks 'all-mode-hook)) + +(defun all-mode-find (pos) + ;; Find position in original buffer corresponding to POS. + (let ((overlay (all-mode-find-overlay pos))) + (if overlay + (+ (marker-position (overlay-get overlay 'marker)) + (- pos (overlay-start overlay)))))) + +(defun all-mode-find-overlay (pos) + ;; Find the overlay containing POS. + (let ((overlays (overlays-at pos))) + (while (and overlays (null (overlay-get (car overlays) 'marker))) + (setq overlays (cdr overlays))) + (car-safe overlays))) + +(defun all-mode-goto () + "Move point to the corresponding position in the original buffer." + (interactive) + (let ((pos (all-mode-find (point)))) + (if pos + (pop-to-buffer all-buffer) + (error "This text is not from the original buffer")) + (goto-char pos))) + +(defvar all-initialization-p nil) + +(defun all-before-change-function (from to) + ;; Check that change is legal + (and all-buffer + (not all-initialization-p) + (let ((start (all-mode-find-overlay from)) + (end (all-mode-find-overlay to))) + (not (and start (eq start end)))) + (error "Changes should be limited to a single text piece"))) + +(add-hook 'before-change-functions 'all-before-change-function) + +(defun all-after-change-function (from to length) + ;; Propagate changes from *All* buffer. + (and all-buffer + (null all-initialization-p) + (let ((buffer (current-buffer)) + (pos (all-mode-find from))) + (if pos + (progn + (set-buffer all-buffer) + (delete-region pos (+ pos length)) + (save-excursion + (goto-char pos) + (insert-buffer-substring buffer from to)) + (set-buffer buffer)))))) + +(add-hook 'after-change-functions 'all-after-change-function) + +;;;###autoload +(defun all (regexp &optional nlines) + "Show all lines in the current buffer containing a match for REGEXP. + +If a match spreads across multiple lines, all those lines are shown. + +Each line is displayed with NLINES lines before and after, or -NLINES +before if NLINES is negative. +NLINES defaults to `list-matching-lines-default-context-lines'. +Interactively it is the prefix arg. + +The lines are shown in a buffer named `*All*'. +Any changes made in that buffer will be propagated to this buffer." + (interactive (list (let* ((default (car regexp-history)) + (input + (read-from-minibuffer + (if default + (format + "Edit lines matching regexp (default `%s'): " default) + "Edit lines matching regexp: ") + nil nil nil + 'regexp-history))) + (if (> (length input) 0) input + (setcar regexp-history default))) + current-prefix-arg)) + (setq nlines (if nlines (prefix-numeric-value nlines) + list-matching-lines-default-context-lines)) + (setq all-initialization-p t) + (let ((first t) + (buffer (current-buffer)) + (prevend nil) + (prevstart nil) + (prevpos (point-min))) + (with-output-to-temp-buffer "*All*" + (save-excursion + (set-buffer standard-output) + (all-mode) + (setq all-buffer buffer) + (insert "Lines matching ") + (prin1 regexp) + (insert " in buffer " (buffer-name buffer) ?. ?\n) + (insert "--------\n")) + (if (eq buffer standard-output) + (goto-char (point-max))) + (save-excursion + (beginning-of-buffer) + ;; Find next match, but give up if prev match was at end of buffer. + (while (and (not (= prevpos (point-max))) + (re-search-forward regexp nil t)) + (goto-char (match-beginning 0)) + (beginning-of-line) + (setq prevpos (point)) + (goto-char (match-end 0)) + (let* ((start (save-excursion + (goto-char (match-beginning 0)) + (forward-line (if (< nlines 0) nlines (- nlines))) + (point))) + (end (save-excursion + (goto-char (match-end 0)) + (if (> nlines 0) + (forward-line (1+ nlines)) + (forward-line 1)) + (point))) + marker) + (cond ((null prevend) + (setq prevstart start + prevend end)) + ((> start prevend) + (all-insert) + (setq prevstart start + prevend end)) + (t + (setq prevend end))))) + (if prevend + (all-insert))))) + (setq all-initialization-p nil)) + +(defun all-insert () + ;; Insert match. + (save-excursion + (setq marker (make-marker)) + (set-marker marker prevstart) + (set-buffer standard-output) + (let ((from (point)) + to) + (insert-buffer-substring buffer prevstart prevend) + (setq to (point)) + (overlay-put (make-overlay from to) 'marker marker) + (goto-char from) + (while (re-search-forward regexp to t) + (overlay-put (make-overlay (match-beginning 0) (match-end 0)) + 'face 'highlight)) + (goto-char to) + (if (> nlines 0) + (insert "--------\n"))))) + +(provide 'all) + +;;; all.el ends here diff --git a/elisp/emacs-goodies-el/apache-mode.el b/elisp/emacs-goodies-el/apache-mode.el new file mode 100644 index 0000000..9523058 --- /dev/null +++ b/elisp/emacs-goodies-el/apache-mode.el @@ -0,0 +1,829 @@ +;;; apache-mode.el --- major mode for editing Apache configuration files + +;; Copyright (c) 2004, 2005 Karl Chen +;; Copyright (c) 1999 Jonathan Marten + +;; Author: Karl Chen + +;; Keywords: languages, faces +;; Last edit: 2005-01-06 +;; Version: 2.0 $Id: apache-mode.el,v 1.6 2016/11/06 19:22:39 psg Exp $ + +;; apache-mode.el 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. +;; +;; It 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 your copy of 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: +;; +;; (autoload 'apache-mode "apache-mode" nil t) +;; (add-to-list 'auto-mode-alist '("\\.htaccess\\'" . apache-mode)) +;; (add-to-list 'auto-mode-alist '("httpd\\.conf\\'" . apache-mode)) +;; (add-to-list 'auto-mode-alist '("srm\\.conf\\'" . apache-mode)) +;; (add-to-list 'auto-mode-alist '("access\\.conf\\'" . apache-mode)) +;; (add-to-list 'auto-mode-alist '("sites-\\(available\\|enabled\\)/" . apache-mode)) +;; + +;;; History: + +;; 1999-10 Jonathan Marten +;; initial version + +;; 2004-09-12 Karl Chen +;; rewrote pretty much everything using define-derived-mode; added support +;; for Apache 2.x; fixed highlighting in GNU Emacs; created indentation +;; function +;; +;; 2005-06-29 Kumar Appaiah +;; use syntax table instead of font-lock-keywords to highlight comments. +;; +;; 2015-08-23 David Maus +;; update list of directives for Apache 2.4 + +;;; Code: + +;; Requires +(require 'regexp-opt) + +(defvar apache-indent-level 4 + "*Number of spaces to indent per level") + +(defvar apache-mode-syntax-table + (let ((table (make-syntax-table))) + (modify-syntax-entry ?_ "_" table) + (modify-syntax-entry ?- "_" table) + (modify-syntax-entry ?( "()" table) + (modify-syntax-entry ?) ")(" table) + (modify-syntax-entry ?< "(>" table) + (modify-syntax-entry ?> ")<" table) + (modify-syntax-entry ?\" "\"" table) + (modify-syntax-entry ?, "." table) + (modify-syntax-entry ?# "<" table) + (modify-syntax-entry ?\n ">#" table) + table)) + +;;;###autoload +(define-derived-mode apache-mode fundamental-mode "Apache" + "Major mode for editing Apache configuration files." + + (set (make-local-variable 'comment-start) "# ") + (set (make-local-variable 'comment-start-skip) "#\\W*") + (set (make-local-variable 'comment-column) 48) + + (set (make-local-variable 'indent-line-function) 'apache-indent-line) + + (set (make-local-variable 'font-lock-defaults) + '(apache-font-lock-keywords nil t + ((?_ . "w") + (?- . "w")) + beginning-of-line))) + +;; Font lock +(defconst apache-font-lock-keywords + (purecopy + (list + + ;; see syntax table for comment highlighting + + ;; (list "^[ \t]*#.*" 0 'font-lock-comment-face t) + + (list (concat ; sections + "^[ \t]*") + 1 'font-lock-function-name-face) + + (list (concat ; directives + "^[ \t]*" + (regexp-opt ' + ( + "AcceptFilter" + "AcceptPathInfo" + "AccessFileName" + "Action" + "AddAlt" + "AddAltByEncoding" + "AddAltByType" + "AddCharset" + "AddDefaultCharset" + "AddDescription" + "AddEncoding" + "AddHandler" + "AddIcon" + "AddIconByEncoding" + "AddIconByType" + "AddInputFilter" + "AddLanguage" + "AddModuleInfo" + "AddOutputFilter" + "AddOutputFilterByType" + "AddType" + "Alias" + "AliasMatch" + "Allow" + "AllowCONNECT" + "AllowEncodedSlashes" + "AllowMethods" + "AllowOverride" + "AllowOverrideList" + "Anonymous" + "Anonymous_LogEmail" + "Anonymous_MustGiveEmail" + "Anonymous_NoUserID" + "Anonymous_VerifyEmail" + "AsyncRequestWorkerFactor" + "AuthBasicAuthoritative" + "AuthBasicFake" + "AuthBasicProvider" + "AuthBasicUseDigestAlgorithm" + "AuthDBDUserPWQuery" + "AuthDBDUserRealmQuery" + "AuthDBMGroupFile" + "AuthDBMType" + "AuthDBMUserFile" + "AuthDigestAlgorithm" + "AuthDigestDomain" + "AuthDigestNonceLifetime" + "AuthDigestProvider" + "AuthDigestQop" + "AuthDigestShmemSize" + "AuthFormAuthoritative" + "AuthFormBody" + "AuthFormDisableNoStore" + "AuthFormFakeBasicAuth" + "AuthFormLocation" + "AuthFormLoginRequiredLocation" + "AuthFormLoginSuccessLocation" + "AuthFormLogoutLocation" + "AuthFormMethod" + "AuthFormMimetype" + "AuthFormPassword" + "AuthFormProvider" + "AuthFormSitePassphrase" + "AuthFormSize" + "AuthFormUsername" + "AuthGroupFile" + "AuthLDAPAuthorizePrefix" + "AuthLDAPBindAuthoritative" + "AuthLDAPBindDN" + "AuthLDAPBindPassword" + "AuthLDAPCharsetConfig" + "AuthLDAPCompareAsUser" + "AuthLDAPCompareDNOnServer" + "AuthLDAPDereferenceAliases" + "AuthLDAPGroupAttribute" + "AuthLDAPGroupAttributeIsDN" + "AuthLDAPInitialBindAsUser" + "AuthLDAPInitialBindPattern" + "AuthLDAPMaxSubGroupDepth" + "AuthLDAPRemoteUserAttribute" + "AuthLDAPRemoteUserIsDN" + "AuthLDAPSearchAsUser" + "AuthLDAPSubGroupAttribute" + "AuthLDAPSubGroupClass" + "AuthLDAPUrl" + "AuthMerging" + "AuthName" + "AuthnCacheContext" + "AuthnCacheEnable" + "AuthnCacheProvideFor" + "AuthnCacheSOCache" + "AuthnCacheTimeout" + "AuthnzFcgiCheckAuthnProvider" + "AuthnzFcgiDefineProvider" + "AuthType" + "AuthUserFile" + "AuthzDBDLoginToReferer" + "AuthzDBDQuery" + "AuthzDBDRedirectQuery" + "AuthzDBMType" + "AuthzSendForbiddenOnFailure" + "BalancerGrowth" + "BalancerInherit" + "BalancerMember" + "BalancerPersist" + "BrowserMatch" + "BrowserMatchNoCase" + "BufferedLogs" + "BufferSize" + "CacheDefaultExpire" + "CacheDetailHeader" + "CacheDirLength" + "CacheDirLevels" + "CacheDisable" + "CacheEnable" + "CacheFile" + "CacheHeader" + "CacheIgnoreCacheControl" + "CacheIgnoreHeaders" + "CacheIgnoreNoLastMod" + "CacheIgnoreQueryString" + "CacheIgnoreURLSessionIdentifiers" + "CacheKeyBaseURL" + "CacheLastModifiedFactor" + "CacheLock" + "CacheLockMaxAge" + "CacheLockPath" + "CacheMaxExpire" + "CacheMaxFileSize" + "CacheMinExpire" + "CacheMinFileSize" + "CacheNegotiatedDocs" + "CacheQuickHandler" + "CacheReadSize" + "CacheReadTime" + "CacheRoot" + "CacheSocache" + "CacheSocacheMaxSize" + "CacheSocacheMaxTime" + "CacheSocacheMinTime" + "CacheSocacheReadSize" + "CacheSocacheReadTime" + "CacheStaleOnError" + "CacheStoreExpired" + "CacheStoreNoStore" + "CacheStorePrivate" + "CGIDScriptTimeout" + "CGIMapExtension" + "CGIPassAuth" + "CharsetDefault" + "CharsetOptions" + "CharsetSourceEnc" + "CheckCaseOnly" + "CheckSpelling" + "ChrootDir" + "ContentDigest" + "CookieDomain" + "CookieExpires" + "CookieName" + "CookieStyle" + "CookieTracking" + "CoreDumpDirectory" + "CustomLog" + "Dav" + "DavDepthInfinity" + "DavGenericLockDB" + "DavLockDB" + "DavMinTimeout" + "DBDExptime" + "DBDInitSQL" + "DBDKeep" + "DBDMax" + "DBDMin" + "DBDParams" + "DBDPersist" + "DBDPrepareSQL" + "DBDriver" + "DefaultIcon" + "DefaultLanguage" + "DefaultRuntimeDir" + "DefaultType" + "Define" + "DeflateBufferSize" + "DeflateCompressionLevel" + "DeflateFilterNote" + "DeflateInflateLimitRequestBody" + "DeflateInflateRatioBurst" + "DeflateInflateRatioLimit" + "DeflateMemLevel" + "DeflateWindowSize" + "Deny" + "DirectoryCheckHandler" + "DirectoryIndex" + "DirectoryIndexRedirect" + "DirectorySlash" + "DocumentRoot" + "DTracePrivileges" + "DumpIOInput" + "DumpIOOutput" + "EnableExceptionHook" + "EnableMMAP" + "EnableSendfile" + "Error" + "ErrorDocument" + "ErrorLog" + "ErrorLogFormat" + "Example" + "ExpiresActive" + "ExpiresByType" + "ExpiresDefault" + "ExtendedStatus" + "ExtFilterDefine" + "ExtFilterOptions" + "FallbackResource" + "FileETag" + "FilterChain" + "FilterDeclare" + "FilterProtocol" + "FilterProvider" + "FilterTrace" + "ForceLanguagePriority" + "ForceType" + "ForensicLog" + "GprofDir" + "GracefulShutdownTimeout" + "Group" + "Header" + "HeaderName" + "HeartbeatAddress" + "HeartbeatListen" + "HeartbeatMaxServers" + "HeartbeatStorage" + "HeartbeatStorage" + "HostnameLookups" + "IdentityCheck" + "IdentityCheckTimeout" + "ImapBase" + "ImapDefault" + "ImapMenu" + "Include" + "IncludeOptional" + "IndexHeadInsert" + "IndexIgnore" + "IndexIgnoreReset" + "IndexOptions" + "IndexOrderDefault" + "IndexStyleSheet" + "InputSed" + "ISAPIAppendLogToErrors" + "ISAPIAppendLogToQuery" + "ISAPICacheFile" + "ISAPIFakeAsync" + "ISAPILogNotSupported" + "ISAPIReadAheadBuffer" + "KeepAlive" + "KeepAliveTimeout" + "KeptBodySize" + "LanguagePriority" + "LDAPCacheEntries" + "LDAPCacheTTL" + "LDAPConnectionPoolTTL" + "LDAPConnectionTimeout" + "LDAPLibraryDebug" + "LDAPOpCacheEntries" + "LDAPOpCacheTTL" + "LDAPReferralHopLimit" + "LDAPReferrals" + "LDAPRetries" + "LDAPRetryDelay" + "LDAPSharedCacheFile" + "LDAPSharedCacheSize" + "LDAPTimeout" + "LDAPTrustedClientCert" + "LDAPTrustedGlobalCert" + "LDAPTrustedMode" + "LDAPVerifyServerCert" + "LimitInternalRecursion" + "LimitRequestBody" + "LimitRequestFields" + "LimitRequestFieldSize" + "LimitRequestLine" + "LimitXMLRequestBody" + "Listen" + "ListenBackLog" + "LoadFile" + "LoadModule" + "LogFormat" + "LogIOTrackTTFB" + "LogLevel" + "LogMessage" + "LuaAuthzProvider" + "LuaCodeCache" + "LuaHookAccessChecker" + "LuaHookAuthChecker" + "LuaHookCheckUserID" + "LuaHookFixups" + "LuaHookInsertFilter" + "LuaHookLog" + "LuaHookMapToStorage" + "LuaHookTranslateName" + "LuaHookTypeChecker" + "LuaInherit" + "LuaInputFilter" + "LuaMapHandler" + "LuaOutputFilter" + "LuaPackageCPath" + "LuaPackagePath" + "LuaQuickHandler" + "LuaRoot" + "LuaScope" + "MaxConnectionsPerChild" + "MaxKeepAliveRequests" + "MaxMemFree" + "MaxRangeOverlaps" + "MaxRangeReversals" + "MaxRanges" + "MaxRequestWorkers" + "MaxSpareServers" + "MaxSpareThreads" + "MaxThreads" + "MergeTrailers" + "MetaDir" + "MetaFiles" + "MetaSuffix" + "MimeMagicFile" + "MinSpareServers" + "MinSpareThreads" + "MMapFile" + "ModemStandard" + "ModMimeUsePathInfo" + "MultiviewsMatch" + "Mutex" + "NameVirtualHost" + "NoProxy" + "NWSSLTrustedCerts" + "NWSSLUpgradeable" + "Options" + "Order" + "OutputSed" + "PassEnv" + "PidFile" + "PrivilegesMode" + "Protocol" + "ProtocolEcho" + "ProxyAddHeaders" + "ProxyBadHeader" + "ProxyBlock" + "ProxyDomain" + "ProxyErrorOverride" + "ProxyExpressDBMFile" + "ProxyExpressDBMType" + "ProxyExpressEnable" + "ProxyFtpDirCharset" + "ProxyFtpEscapeWildcards" + "ProxyFtpListOnWildcard" + "ProxyHTMLBufSize" + "ProxyHTMLCharsetOut" + "ProxyHTMLDocType" + "ProxyHTMLEnable" + "ProxyHTMLEvents" + "ProxyHTMLExtended" + "ProxyHTMLFixups" + "ProxyHTMLInterp" + "ProxyHTMLLinks" + "ProxyHTMLMeta" + "ProxyHTMLStripComments" + "ProxyHTMLURLMap" + "ProxyIOBufferSize" + "ProxyMaxForwards" + "ProxyPass" + "ProxyPassInherit" + "ProxyPassInterpolateEnv" + "ProxyPassMatch" + "ProxyPassReverse" + "ProxyPassReverseCookieDomain" + "ProxyPassReverseCookiePath" + "ProxyPreserveHost" + "ProxyReceiveBufferSize" + "ProxyRemote" + "ProxyRemoteMatch" + "ProxyRequests" + "ProxySCGIInternalRedirect" + "ProxySCGISendfile" + "ProxySet" + "ProxySourceAddress" + "ProxyStatus" + "ProxyTimeout" + "ProxyVia" + "ReadmeName" + "ReceiveBufferSize" + "Redirect" + "RedirectMatch" + "RedirectPermanent" + "RedirectTemp" + "ReflectorHeader" + "RemoteIPHeader" + "RemoteIPInternalProxy" + "RemoteIPInternalProxyList" + "RemoteIPProxiesHeader" + "RemoteIPTrustedProxy" + "RemoteIPTrustedProxyList" + "RemoveCharset" + "RemoveEncoding" + "RemoveHandler" + "RemoveInputFilter" + "RemoveLanguage" + "RemoveOutputFilter" + "RemoveType" + "RequestHeader" + "RequestReadTimeout" + "Require" + "RewriteBase" + "RewriteCond" + "RewriteEngine" + "RewriteMap" + "RewriteOptions" + "RewriteRule" + "RLimitCPU" + "RLimitMEM" + "RLimitNPROC" + "Satisfy" + "ScoreBoardFile" + "Script" + "ScriptAlias" + "ScriptAliasMatch" + "ScriptInterpreterSource" + "ScriptLog" + "ScriptLogBuffer" + "ScriptLogLength" + "ScriptSock" + "SecureListen" + "SeeRequestTail" + "SendBufferSize" + "ServerAdmin" + "ServerAlias" + "ServerLimit" + "ServerName" + "ServerPath" + "ServerRoot" + "ServerSignature" + "ServerTokens" + "Session" + "SessionCookieName" + "SessionCookieName2" + "SessionCookieRemove" + "SessionCryptoCipher" + "SessionCryptoDriver" + "SessionCryptoPassphrase" + "SessionCryptoPassphraseFile" + "SessionDBDCookieName" + "SessionDBDCookieName2" + "SessionDBDCookieRemove" + "SessionDBDDeleteLabel" + "SessionDBDInsertLabel" + "SessionDBDPerUser" + "SessionDBDSelectLabel" + "SessionDBDUpdateLabel" + "SessionEnv" + "SessionExclude" + "SessionHeader" + "SessionInclude" + "SessionMaxAge" + "SetEnv" + "SetEnvIf" + "SetEnvIfExpr" + "SetEnvIfNoCase" + "SetHandler" + "SetInputFilter" + "SetOutputFilter" + "SSIEndTag" + "SSIErrorMsg" + "SSIETag" + "SSILastModified" + "SSILegacyExprParser" + "SSIStartTag" + "SSITimeFormat" + "SSIUndefinedEcho" + "SSLCACertificateFile" + "SSLCACertificatePath" + "SSLCADNRequestFile" + "SSLCADNRequestPath" + "SSLCARevocationCheck" + "SSLCARevocationFile" + "SSLCARevocationPath" + "SSLCertificateChainFile" + "SSLCertificateFile" + "SSLCertificateKeyFile" + "SSLCipherSuite" + "SSLCompression" + "SSLCryptoDevice" + "SSLEngine" + "SSLFIPS" + "SSLHonorCipherOrder" + "SSLInsecureRenegotiation" + "SSLOCSPDefaultResponder" + "SSLOCSPEnable" + "SSLOCSPOverrideResponder" + "SSLOCSPResponderTimeout" + "SSLOCSPResponseMaxAge" + "SSLOCSPResponseTimeSkew" + "SSLOCSPUseRequestNonce" + "SSLOpenSSLConfCmd" + "SSLOptions" + "SSLPassPhraseDialog" + "SSLProtocol" + "SSLProxyCACertificateFile" + "SSLProxyCACertificatePath" + "SSLProxyCARevocationCheck" + "SSLProxyCARevocationFile" + "SSLProxyCARevocationPath" + "SSLProxyCheckPeerCN" + "SSLProxyCheckPeerExpire" + "SSLProxyCheckPeerName" + "SSLProxyCipherSuite" + "SSLProxyEngine" + "SSLProxyMachineCertificateChainFile" + "SSLProxyMachineCertificateFile" + "SSLProxyMachineCertificatePath" + "SSLProxyProtocol" + "SSLProxyVerify" + "SSLProxyVerifyDepth" + "SSLRandomSeed" + "SSLRenegBufferSize" + "SSLRequire" + "SSLRequireSSL" + "SSLSessionCache" + "SSLSessionCacheTimeout" + "SSLSessionTicketKeyFile" + "SSLSessionTickets" + "SSLSRPUnknownUserSeed" + "SSLSRPVerifierFile" + "SSLStaplingCache" + "SSLStaplingErrorCacheTimeout" + "SSLStaplingFakeTryLater" + "SSLStaplingForceURL" + "SSLStaplingResponderTimeout" + "SSLStaplingResponseMaxAge" + "SSLStaplingResponseTimeSkew" + "SSLStaplingReturnResponderErrors" + "SSLStaplingStandardCacheTimeout" + "SSLStrictSNIVHostCheck" + "SSLUserName" + "SSLUseStapling" + "SSLVerifyClient" + "SSLVerifyDepth" + "StartServers" + "StartThreads" + "Substitute" + "SubstituteMaxLineLength" + "Suexec" + "SuexecUserGroup" + "ThreadLimit" + "ThreadsPerChild" + "ThreadStackSize" + "TimeOut" + "TraceEnable" + "TransferLog" + "TypesConfig" + "UnDefine" + "UndefMacro" + "UnsetEnv" + "Use" + "UseCanonicalName" + "UseCanonicalPhysicalPort" + "User" + "UserDir" + "VHostCGIMode" + "VHostCGIPrivs" + "VHostGroup" + "VHostPrivs" + "VHostSecure" + "VHostUser" + "VirtualDocumentRoot" + "VirtualDocumentRootIP" + "VirtualScriptAlias" + "VirtualScriptAliasIP" + "WatchdogInterval" + "XBitHack" + "xml2EncAlias" + "xml2EncDefault" + "xml2StartParse" + ) + 'words)) + 1 'font-lock-keyword-face) + + (list ; values + (regexp-opt ' + ( + "All" + "AuthConfig" + "Basic" + "CONNECT" + "DELETE" + "Digest" + "ExecCGI" + "FancyIndexing" + "FileInfo" + "FollowSymLinks" + "Full" + "GET" + "IconsAreLinks" + "Includes" + "IncludesNOEXEC" + "Indexes" + "Limit" + "Minimal" + "MultiViews" + "None" + "OPTIONS" + "OS" + "Options" + "Options" + "POST" + "PUT" + "ScanHTMLTitles" + "SuppressDescription" + "SuppressLastModified" + "SuppressSize" + "SymLinksIfOwnerMatch" + "URL" + "add" + "allow" + "any" + "append" + "deny" + "double" + "downgrade-1.0" + "email" + "env" + "error" + "force-response-1.0" + "formatted" + "from" + "full" + "gone" + "group" + "inetd" + "inherit" + "map" + "mutual-failure" + "nocontent" + "nokeepalive" + "none" + "off" + "on" + "permanent" + "referer" + "seeother" + "semi-formatted" + "set" + "standalone" + "temporary" + "unformatted" + "unset" + "user" + "valid-user" + ) 'words) + 1 'font-lock-type-face))) + "Expressions to highlight in Apache config buffers.") + +(defun apache-indent-line () + "Indent current line of Apache code." + (interactive) + (let ((savep (> (current-column) (current-indentation))) + (indent (max (apache-calculate-indentation) 0))) + (if savep + (save-excursion (indent-line-to indent)) + (indent-line-to indent)))) + + +(defun apache-previous-indentation () + ;; Return the previous (non-empty/comment) indentation. Doesn't save + ;; position. + (let (indent) + (while (and (null indent) + (zerop (forward-line -1))) + (unless (looking-at "[ \t]*\\(#\\|$\\)") + (setq indent (current-indentation)))) + (or indent 0))) + +(defun apache-calculate-indentation () + ;; Return the amount the current line should be indented. + (save-excursion + (forward-line 0) + (if (bobp) + 0 + (let ((ends-section-p (looking-at "[ \t]* +;; Maintainer: Vinicius Jose Latorre +;; Time-stamp: <2011/01/12 00:58:17 vinicius> +;; Keywords: data, ascii +;; Version: 3.1 +;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre + +;; This file is *NOT* (yet?) part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify it +;; under the terms of the GNU General Public License as published by the Free +;; Software Foundation; either version 2, or (at your option) any later +;; version. + +;; This program is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for +;; more details. + +;; You should have received a copy of the GNU General Public License along with +;; 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: + +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Introduction +;; ------------ +;; +;; This package provides a way to display ASCII code on a window, that is, +;; display in another window an ASCII table highlighting the current character +;; code. +;; +;; Well, maybe the name "ascii" is not a good name for this package, as this +;; package also displays non-ASCII code, that is, character code which is +;; greater than 255. It also displays characters codified in HTML (Á), +;; quoted (=20), escaped (\xFF) and Emacs Lisp character (?\^A). +;; +;; To use ascii, insert in your ~/.emacs: +;; +;; (require 'ascii) +;; +;; Or: +;; +;; (autoload 'ascii-on "ascii" "Turn on ASCII code display." t) +;; (autoload 'ascii-off "ascii" "Turn off ASCII code display." t) +;; (autoload 'ascii-display "ascii" "Toggle ASCII code display." t) +;; (autoload 'ascii-customize "ascii" "Customize ASCII code display." t) +;; +;; For good performance, be sure to byte-compile ascii.el, e.g. +;; +;; M-x byte-compile-file +;; +;; This will generate ascii.elc, which will be loaded instead of ascii.el. +;; +;; It runs on GNU Emacs 20.4.1, 21, 22 and 23. +;; +;; +;; Using ascii +;; ----------- +;; +;; To activate ascii, type: +;; +;; M-x ascii-on RET +;; +;; Or: +;; +;; C-u 1 M-x ascii-display RET +;; +;; To deactivate ascii, type: +;; +;; M-x ascii-off RET +;; +;; Or: +;; +;; C-u 0 M-x ascii-display RET +;; +;; To toggle ascii, type: +;; +;; M-x ascii-display RET +;; +;; To customize ascii, type: +;; +;; M-x ascii-customize RET +;; +;; You can also bind `ascii-display', `ascii-on', `ascii-off' and +;; `ascii-customize' to some key, like: +;; +;; (global-set-key "\C-c\C-a" 'ascii-on) +;; (global-set-key "\C-c\C-e" 'ascii-off) +;; (global-set-key "\C-c\C-t" 'ascii-display) +;; (global-set-key "\C-c\C-c" 'ascii-customize) +;; +;; If you're using `mule' package, a good usage example is to activate `ascii' +;; on emacs/etc/HELLO file. +;; +;; +;; Hooks +;; ----- +;; +;; ascii has the following hook variable: +;; +;; `ascii-hook' +;; It is evaluated once when ascii is turned on. +;; +;; +;; Options +;; ------- +;; +;; Below it's shown a brief description of ascii options, please, see the +;; options declaration in the code for a long documentation. +;; +;; `ascii-code' Specify list of character code to +;; display. +;; +;; `ascii-show-nonascii' Non-nil means converts to unibyte and +;; display the ascii code. +;; +;; `ascii-show-nonascii-message' Non-nil means show a message when +;; character is above 255. +;; +;; `ascii-window-size' Specify initial ASCII window size. +;; +;; `ascii-display-code' Specify list of character range to be +;; displayed. +;; +;; `ascii-keep-window' Non-nil means to keep ASCII window +;; active. +;; +;; `ascii-table-separator' Specify string used to separate ASCII +;; table columns. +;; +;; `ascii-ascii-face' Specify symbol face used to highlight +;; ascii code. +;; +;; `ascii-non-ascii-face' Specify symbol face used to highlight +;; non-ascii code. +;; +;; To set the above options you may: +;; +;; a) insert the code in your ~/.emacs, like: +;; +;; (setq ascii-window-size 6) +;; +;; This way always keep your default settings when you enter a new Emacs +;; session. +;; +;; b) or use `set-variable' in your Emacs session, like: +;; +;; M-x set-variable RET ascii-window-size RET 6 RET +;; +;; This way keep your settings only during the current Emacs session. +;; +;; c) or use customization, for example: +;; click on menu-bar *Help* option, +;; then click on *Customize*, +;; then click on *Browse Customization Groups*, +;; expand *Data* group, +;; expand *Ascii* group +;; and then customize ascii options. +;; Through this way, you may choose if the settings are kept or not when +;; you leave out the current Emacs session. +;; +;; d) or see the option value: +;; +;; C-h v ascii-window-size RET +;; +;; and click the *customize* hypertext button. +;; Through this way, you may choose if the settings are kept or not when +;; you leave out the current Emacs session. +;; +;; e) or invoke: +;; +;; M-x ascii-customize RET +;; +;; and then customize ascii options. +;; Through this way, you may choose if the settings are kept or not when +;; you leave out the current Emacs session. +;; +;; +;; Acknowledgments +;; --------------- +;; +;; Thanks to Steven W. Orr for patch to Emacs 23. +;; +;; Thanks to Roman Belenov for suggestion on dynamic ascii +;; table evaluation (depending on character encoding). +;; +;; Thanks to Alex Schroeder for suggestion on customization. +;; +;; +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; code: + + +;; XEmacs needs overlay emulation package. +(eval-and-compile + (and (let (case-fold-search) + (string-match "XEmacs\\|Lucid\\|Epoch" emacs-version)) + (not (require 'overlay)) + (error "`ascii' requires `overlay' package."))) + + +;; GNU Emacs 20, 21 and 22 compatibility +(or (fboundp 'characterp) + (defalias 'characterp 'char-valid-p)) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; User Variables: + + +;;; Interface to the command system + + +(defgroup ascii nil + "ASCII code display" + :link '(emacs-library-link :tag "Source Lisp File" "ascii.el") + :prefix "ascii-" + :group 'data) + + +(defcustom ascii-code '(quoted html backslash elisp) + "*Specify list of character code to display. + +If list is nil, display only ASCII code. + +If list is non-nil, valid element values are: + + quoted display quoted and ASCII code. + Quoted code is specified by `=HH' where H is a hexadecimal + character or by `=' followed by newline. This character coding + is used on MIME. For example: + =FF =1f =20 = + + html display HTML and ASCII code. + HTML code is specified by `&CODE;', for example: + á Á À + + backslash display backslash and ASCII code. + Backslash code is specified by `\\CODE' like in C, for example: + \\177 \\xFF \\x1f \\t \\Z \\\\ + + elisp display Emacs Lisp and ASCII code. + Emacs Lisp code is specified by `?CODE', see how Emacs Lisp + specify a character. For example: + ?? ?a ?A ?\\^A ?\\C-A + ?\\177 ?\\xFF ?\\x1f ?\\t ?\\Z ?\\\\ + +Any other value is ignored." + :type '(repeat :tag "ASCII Code List" + (choice :menu-tag "ASCII Code" + :tag "ASCII Code" + (const :tag "Quoted" quoted) + (const :tag "HTML" html) + (const :tag "Backslash" backslash) + (const :tag "Elisp" elisp))) + :group 'ascii) + + +(defcustom ascii-show-nonascii t + "*Non-nil means converts to unibyte and display the ascii code." + :type 'boolean + :group 'ascii) + + +(defcustom ascii-show-nonascii-message t + "*Non-nil means show a message when character is above 255." + :type 'boolean + :group 'ascii) + + +(defcustom ascii-window-size 6 + "*Specify initial ASCII window size." + :type 'integer + :group 'ascii) + + +(defcustom ascii-display-code '((?\000 . ?\377)) + "*Specify list of character range to be displayed. + +Each element has the following form: + + (LOWER . UPPER) + +LOWER and UPPER are the minimum and maximum character code, respectively. +A character is displayed if: + LOWER <= character <= UPPER + and 0 <= LOWER <= 255 + and 0 <= UPPER <= 255" + :type '(repeat :tag "Range List" + (cons :tag "Range" + (integer :tag "From") + (integer :tag "To"))) + :group 'ascii) + + +(defcustom ascii-keep-window t + "*Non-nil means to keep ASCII window active." + :type 'boolean + :group 'ascii) + + +(defcustom ascii-table-separator "|" + "*Specify string used to separate ASCII table columns." + :type 'string + :group 'ascii) + + +(defcustom ascii-ascii-face 'ascii-ascii-face + "*Specify symbol face used to highlight ascii code." + :type 'face + :group 'ascii) + + +;; secondary-selection face +(defface ascii-ascii-face + '((((type tty) (class color)) + (:background "cyan" :foreground "black")) + (((class color) (background light)) + (:background "paleturquoise")) + (((class color) (background dark)) + (:background "SkyBlue4")) + (t (:inverse-video t))) + "Face used to highlight ascii code.") + + +(defcustom ascii-non-ascii-face 'ascii-non-ascii-face + "*Specify symbol face used to highlight non-ascii code." + :type 'face + :group 'ascii) + + +;; highlight face +(defface ascii-non-ascii-face + '((((type tty) (class color)) + (:background "green")) + (((class color) (background light)) + (:background "darkseagreen2")) + (((class color) (background dark)) + (:background "darkolivegreen")) + (t (:inverse-video t))) + "Face used to highlight non-ascii code.") + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Customization + + +;;;###autoload +(defun ascii-customize () + "Customize ASCII options." + (interactive) + (customize-group 'ascii)) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; User commands + + +(defconst ascii-buffer-name " *ASCII*") + + +(defvar ascii-overlay nil) +(defvar ascii-reference-count 0) + + +(defvar ascii-display nil) +(make-variable-buffer-local 'ascii-display) + + +;;;###autoload +(defun ascii-display (&optional arg) + "Toggle ASCII code display. + +If ARG is null, toggle ASCII code display. +If ARG is a number and is greater than zero, turn on display; otherwise, turn +off display. +If ARG is anything else, turn on display." + (interactive "P") + (if (if arg + (> (prefix-numeric-value arg) 0) + (not ascii-display)) + (ascii-on) + (ascii-off))) + + +;;;###autoload +(defun ascii-on () + "Turn on ASCII code display." + (interactive) + (unless ascii-display + (setq ascii-display t + ascii-reference-count (1+ ascii-reference-count)) + ;; local hooks + (add-hook 'post-command-hook 'ascii-post-command nil t) + (add-hook 'kill-buffer-hook 'ascii-off nil t) + ;; own hook + (run-hooks 'ascii-hook) + (ascii-post-command))) + + +;;;###autoload +(defun ascii-off () + "Turn off ASCII code display." + (interactive) + (when ascii-display + (setq ascii-display nil + ascii-reference-count (1- ascii-reference-count)) + (remove-hook 'post-command-hook 'ascii-post-command t) + (remove-hook 'kill-buffer-hook 'ascii-off t) + (if (> ascii-reference-count 0) + ;; at least one buffer with ascii activated + (or ascii-keep-window + (ascii-hide-table)) + ;; *no* buffer with ascii activated + (and ascii-overlay + (delete-overlay ascii-overlay)) + (let ((buffer (get-buffer ascii-buffer-name))) + (and buffer + (save-excursion + (delete-windows-on buffer) + (kill-buffer buffer))))))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Internal variables + + +(defconst ascii-table + (concat + ;; (0 <= x <= 127) + " OCT DEC HX |- OCT DEC HX |- OCT DEC HX \ +|- OCT DEC HX\n" + (let ((str "") + (c -1) + (cod [ + "C-@ NUL ^@ " ; 0 + "C-a SOH ^A " ; 1 + "C-b STX ^B " ; 2 + "C-c ETX ^C " ; 3 + "C-d EOT ^D " ; 4 + "C-e ENQ ^E " ; 5 + "C-f ACK ^F " ; 6 + "C-g BEL ^G \\a" ; 7 + "C-h BS ^H \\b" ; 8 + "TAB HT ^I \\t" ; 9 + "C-j LF ^J \\n" ; 10 + "C-k VT ^K \\v" ; 11 + "C-l FF ^L \\f" ; 12 + "RET CR ^M \\r" ; 13 + "C-n SO ^N " ; 14 + "C-o SI ^O " ; 15 + "C-p DLE ^P " ; 16 + "C-q DC1 ^Q " ; 17 + "C-r DC2 ^R " ; 18 + "C-s DC3 ^S " ; 19 + "C-t DC4 ^T " ; 20 + "C-u NAK ^U " ; 21 + "C-v SYN ^V " ; 22 + "C-w ETB ^W " ; 23 + "C-x CAN ^X " ; 24 + "C-y EM ^Y " ; 25 + "C-z SUB ^Z " ; 26 + "ESC ESC ^[ \\e" ; 27 + "C-\\ FS ^\\ " ; 28 + "C-] GS ^] " ; 29 + "C-^ RS ^^ " ; 30 + "C-_ US ^_ " ; 31 + ]) + c32 c64 c96) + (while (< c 31) + (setq c (1+ c) + c32 (+ c 32) + c64 (+ c 64) + c96 (+ c 96) + str (concat + str + (format "\\%03o %03d %02x %s|| \\%03o %03d %02x %s|| \ +\\%03o %03d %02x %c || \\%03o %03d %02x %s\n" + c c c (aref cod c) + c32 c32 c32 + (if (= c32 ?\x20) "SPC" (format " %c "c32)) + c64 c64 c64 c64 + c96 c96 c96 + (if (= c96 ?\x7F) "DEL ^?" (format " %c" c96)))))) + str) + + ;; (128 <= x <= 255) + "\n OCT DEC HX |- OCT DEC HX |- OCT DEC HX \ +|- OCT DEC HX\n" + (let ((str "") + (c 127) + c32 c64 c96) + (while (< c 159) + (setq c (1+ c) + c32 (+ c 32) + c64 (+ c 64) + c96 (+ c 96) + str (concat + str + (format "\\%03o %03d %02x \\%03o || \ +\\%03o %03d %02x %c || \\%03o %03d %02x %c || \\%03o %03d %02x %c\n" + c c c c + c32 c32 c32 c32 + c64 c64 c64 c64 + c96 c96 c96 c96)))) + str)) + "ASCII table.") + + +(defconst ascii-position + (vector + ;; 0 1 2 3 + [2 0 23 0] [3 0 23 0] [4 0 23 0] [5 0 23 0] + ;; 4 5 6 7 + [6 0 23 0] [7 0 23 0] [8 0 23 0] [9 0 26 0] + ;; 8 9 10 11 + [10 0 26 0] [11 0 26 0] [12 0 26 0] [13 0 26 0] + ;; 12 13 14 15 + [14 0 26 0] [15 0 26 0] [16 0 23 0] [17 0 23 0] + ;; 16 17 18 19 + [18 0 23 0] [19 0 23 0] [20 0 23 0] [21 0 23 0] + ;; 20 21 22 23 + [22 0 23 0] [23 0 23 0] [24 0 23 0] [25 0 23 0] + ;; 24 25 26 27 + [26 0 23 0] [27 0 23 0] [28 0 23 0] [29 0 26 0] + ;; 28 29 30 31 + [30 0 23 0] [31 0 23 0] [32 0 23 0] [33 0 23 0] + ;; 32 33 34 35 + [2 28 43 1] [3 28 42 1] [4 28 42 1] [5 28 42 1] + ;; 36 37 38 39 + [6 28 42 1] [7 28 42 1] [8 28 42 1] [9 28 42 1] + ;; 40 41 42 43 + [10 28 42 1] [11 28 42 1] [12 28 42 1] [13 28 42 1] + ;; 44 45 46 47 + [14 28 42 1] [15 28 42 1] [16 28 42 1] [17 28 42 1] + ;; 48 49 50 51 + [18 28 42 1] [19 28 42 1] [20 28 42 1] [21 28 42 1] + ;; 52 53 54 55 + [22 28 42 1] [23 28 42 1] [24 28 42 1] [25 28 42 1] + ;; 56 57 58 59 + [26 28 42 1] [27 28 42 1] [28 28 42 1] [29 28 42 1] + ;; 60 61 62 63 + [30 28 42 1] [31 28 42 1] [32 28 42 1] [33 28 42 1] + ;; 64 65 66 67 + [2 45 59 2] [3 45 59 2] [4 45 59 2] [5 45 59 2] + ;; 68 69 70 71 + [6 45 59 2] [7 45 59 2] [8 45 59 2] [9 45 59 2] + ;; 72 73 74 75 + [10 45 59 2] [11 45 59 2] [12 45 59 2] [13 45 59 2] + ;; 76 77 78 79 + [14 45 59 2] [15 45 59 2] [16 45 59 2] [17 45 59 2] + ;; 80 81 82 83 + [18 45 59 2] [19 45 59 2] [20 45 59 2] [21 45 59 2] + ;; 84 85 86 87 + [22 45 59 2] [23 45 59 2] [24 45 59 2] [25 45 59 2] + ;; 88 89 90 91 + [26 45 59 2] [27 45 59 2] [28 45 59 2] [29 45 59 2] + ;; 92 93 94 95 + [30 45 59 2] [31 45 59 2] [32 45 59 2] [33 45 59 2] + ;; 96 97 98 99 + [2 62 76 3] [3 62 76 3] [4 62 76 3] [5 62 76 3] + ;; 100 101 102 103 + [6 62 76 3] [7 62 76 3] [8 62 76 3] [9 62 76 3] + ;; 104 105 106 107 + [10 62 76 3] [11 62 76 3] [12 62 76 3] [13 62 76 3] + ;; 108 109 110 111 + [14 62 76 3] [15 62 76 3] [16 62 76 3] [17 62 76 3] + ;; 112 113 114 115 + [18 62 76 3] [19 62 76 3] [20 62 76 3] [21 62 76 3] + ;; 116 117 118 119 + [22 62 76 3] [23 62 76 3] [24 62 76 3] [25 62 76 3] + ;; 120 121 122 123 + [26 62 76 3] [27 62 76 3] [28 62 76 3] [29 62 76 3] + ;; 124 125 126 127 + [30 62 76 3] [31 62 76 3] [32 62 76 3] [33 62 80 3] + ;; 128 129 130 131 + [36 0 17 0] [37 0 17 0] [38 0 17 0] [39 0 17 0] + ;; 132 133 134 135 + [40 0 17 0] [41 0 17 0] [42 0 17 0] [43 0 17 0] + ;; 136 137 138 139 + [44 0 17 0] [45 0 17 0] [46 0 17 0] [47 0 17 0] + ;; 140 141 142 143 + [48 0 17 0] [49 0 17 0] [50 0 17 0] [51 0 17 0] + ;; 144 145 146 147 + [52 0 17 0] [53 0 17 0] [54 0 14 0] [55 0 17 0] + ;; 148 149 150 151 + [56 0 17 0] [57 0 17 0] [58 0 17 0] [59 0 17 0] + ;; 152 153 154 155 + [60 0 17 0] [61 0 17 0] [62 0 17 0] [63 0 17 0] + ;; 156 157 158 159 + [64 0 17 0] [65 0 17 0] [66 0 17 0] [67 0 17 0] + ;; 160 161 162 163 + [36 28 42 1] [37 28 42 1] [38 28 42 1] [39 28 42 1] + ;; 164 165 166 167 + [40 28 42 1] [41 28 42 1] [42 28 42 1] [43 28 42 1] + ;; 168 169 170 171 + [44 28 42 1] [45 28 42 1] [46 28 42 1] [47 28 42 1] + ;; 172 173 174 175 + [48 28 42 1] [49 28 42 1] [50 28 42 1] [51 28 42 1] + ;; 176 177 178 179 + [52 28 42 1] [53 28 42 1] [54 28 42 1] [55 28 42 1] + ;; 180 181 182 183 + [56 28 42 1] [57 28 42 1] [58 28 42 1] [59 28 42 1] + ;; 184 185 186 187 + [60 28 42 1] [61 28 42 1] [62 28 42 1] [63 28 42 1] + ;; 188 189 190 191 + [64 28 42 1] [65 28 42 1] [66 28 42 1] [67 28 42 1] + ;; 192 193 194 195 + [36 45 59 2] [37 45 59 2] [38 45 59 2] [39 45 59 2] + ;; 196 197 198 199 + [40 45 59 2] [41 45 59 2] [42 45 59 2] [43 45 59 2] + ;; 200 201 202 203 + [44 45 59 2] [45 45 59 2] [46 45 59 2] [47 45 59 2] + ;; 204 205 206 207 + [48 45 59 2] [49 45 59 2] [50 45 59 2] [51 45 59 2] + ;; 208 209 210 211 + [52 45 59 2] [53 45 59 2] [54 45 59 2] [55 45 59 2] + ;; 212 213 214 215 + [56 45 59 2] [57 45 59 2] [58 45 59 2] [59 45 59 2] + ;; 216 217 218 219 + [60 45 59 2] [61 45 59 2] [62 45 59 2] [63 45 59 2] + ;; 220 221 222 223 + [64 45 59 2] [65 45 59 2] [66 45 59 2] [67 45 59 2] + ;; 224 225 226 227 + [36 62 76 3] [37 62 76 3] [38 62 76 3] [39 62 76 3] + ;; 228 229 230 231 + [40 62 76 3] [41 62 76 3] [42 62 76 3] [43 62 76 3] + ;; 232 233 234 235 + [44 62 76 3] [45 62 76 3] [46 62 76 3] [47 62 76 3] + ;; 236 237 238 239 + [48 62 76 3] [49 62 76 3] [50 62 76 3] [51 62 76 3] + ;; 240 241 242 243 + [52 62 76 3] [53 62 76 3] [54 62 76 3] [55 62 76 3] + ;; 244 245 246 247 + [56 62 76 3] [57 62 76 3] [58 62 76 3] [59 62 76 3] + ;; 248 249 250 251 + [60 62 76 3] [61 62 76 3] [62 62 76 3] [63 62 76 3] + ;; 252 253 254 255 + [64 62 76 3] [65 62 76 3] [66 62 76 3] [67 62 76 3] + ) + "Vector with position of each ASCII code in ASCII buffer. + +Each element has the following form: + + [LINE COL-BEG COL-END COL-INDEX] + +LINE is the line number in ASCII buffer. +COL-BEG is the ASCII beginning column. +COL-END is the ASCII end column. +COL-INDEX is the ASCII table column index.") + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Internal functions + + +(defun ascii-post-command () + (let* ((char (following-char)) + (code (if ascii-show-nonascii + (string-to-char (string-make-unibyte (char-to-string char))) + char)) + mess) + (cond ((and (boundp 'ascii-display) + ascii-display + (< code 256) + (ascii-display-code code)) + (setq mess (ascii-show-table code (< char 256)))) + ((and (not ascii-keep-window) + (not (string= (buffer-name) ascii-buffer-name))) + (ascii-hide-table)) + (ascii-overlay + (delete-overlay ascii-overlay)) + ) + ;; display some warning + (cond ((and (boundp 'ascii-display) + ascii-display + ascii-show-nonascii-message + (cond + ((> char 255) + (message "Character code above 255 (\\0%o, %d, 0x%x)" + char char char)) + ((< char 0) + (message "Character code below 0 (\\0%o, %d, 0x%x)" + char char char)) + ))) + (mess + (message "%s code" mess)) + ))) + + +(defun ascii-hide-table () + (let ((buffer (get-buffer ascii-buffer-name))) + (and buffer + (delete-windows-on buffer)))) + + +(defconst ascii-html-alist + '(("copy" . 169) ("reg" . 174) ("trade" . 174) ("Aacute" . 192) + ("Agrave" . 193) ("Acirc" . 194) ("Atilde" . 195) ("Auml" . 196) + ("Aring" . 197) ("AElig" . 198) ("Ccedil" . 199) ("Eacute" . 200) + ("Egrave" . 201) ("Ecirc" . 202) ("Euml" . 203) ("Iacute" . 204) + ("Igrave" . 205) ("Icirc" . 206) ("Iuml" . 207) ("ETH" . 208) + ("Ntilde" . 209) ("Oacute" . 210) ("Ograve" . 211) ("Ocirc" . 212) + ("Otilde" . 213) ("Ouml" . 214) ("Oslash" . 216) ("Uacute" . 217) + ("Ugrave" . 218) ("Ucirc" . 219) ("Uuml" . 220) ("Yacute" . 221) + ("THORN" . 222) ("szlig" . 223) ("aacute" . 224) ("agrave" . 225) + ("acirc" . 226) ("atilde" . 227) ("auml" . 228) ("aring" . 229) + ("aelig" . 230) ("ccedil" . 231) ("eacute" . 232) ("egrave" . 233) + ("ecirc" . 234) ("euml" . 235) ("iacute" . 236) ("igrave" . 237) + ("icirc" . 238) ("iuml" . 239) ("eth" . 240) ("ntilde" . 241) + ("oacute" . 242) ("ograve" . 243) ("ocirc" . 244) ("otilde" . 245) + ("ouml" . 246) ("oslash" . 248) ("uacute" . 249) ("ugrave" . 250) + ("ucirc" . 251) ("uuml" . 252) ("yacute" . 253) ("thorn" . 254) + ("yuml" . 255))) + + +;; á Á À +(defconst ascii-html-regexp + (concat "&\\([aeiouy]acute\\|[aeiou]circ\\|[aeiou]grave\\|[aeiouy]uml\\|" + "aelig\\|aring\\|[ano]tilde\\|ccedil\\|copy\\|eth\\|oslash\\|" + "reg\\|szlig\\|thorn\\|trade\\|" + "#[0-9]+\\);")) + + +;; \177 \xFF \t \Z \\ +(defconst ascii-backslash-regexp + "\\\\\\([0-7]+\\|x[0-9A-Fa-f]+\\|\n\\|.\\)") + + +;; ?A ?\^A ?\C-A ?\177 ?\xFF ?\t ?\Z ?\\ +(defconst ascii-elisp-regexp + (concat "?\\(\\\\\\(\\^\\|C-\\)[@A-Za-_]\\|" + ascii-backslash-regexp + "\\|.\\)")) + + +(defsubst ascii-string-matched (level) + (buffer-substring-no-properties + (match-beginning level) (match-end level))) + + +(defsubst ascii-string-to-char (str) + (string-to-char (car (read-from-string (concat "\"" str "\""))))) + + +(defsubst ascii-char-matched (level) + (ascii-string-to-char (ascii-string-matched level))) + + +(defsubst ascii-code (code var-sym) + (save-match-data + (cond + ;; Quoted + ((and (memq 'quoted ascii-code) + (cond ((looking-at "=\n") + (set var-sym "Quoted") + ?\n) + ((looking-at "=\\([0-9A-Fa-f][0-9A-Fa-f]\\)") + (set var-sym "Quoted") + (string-to-number (ascii-string-matched 1) 16))))) + ;; HTML + ((and (memq 'html ascii-code) + (let ((case-fold-search t)) + (looking-at ascii-html-regexp))) + (set var-sym "HTML") + (let ((str (ascii-string-matched 1))) + (cond ((eq (aref str 0) ?#) + (aset str 0 ?\ ) + (let ((int (string-to-number str))) + (if (and (<= 0 int) (<= int 255)) + int + (set var-sym nil) + code))) + ((cdr (assoc str ascii-html-alist))) + (t + (set var-sym nil) + code)))) + ;; backslash + ((and (memq 'backslash ascii-code) + (looking-at ascii-backslash-regexp)) + (set var-sym "Backslash") + (let* ((str (ascii-string-matched 0)) + (last (aref str (1- (length str))))) + (if (memq last '(?^ ?C ?\n)) + last + (ascii-string-to-char str)))) + ;; elisp + ((and (memq 'elisp ascii-code) + (looking-at ascii-elisp-regexp)) + (set var-sym "Elisp") + (ascii-char-matched 1)) + ;; ASCII + (t + (set var-sym nil) + code)))) + + +(defvar ascii-sep-len 0) +(defvar ascii-charset-base 0) + + +(defun ascii-show-table (code ascii-p) + (let ((buffer (ascii-get-buffer code)) + mess) + (and + ;; adjust ascii window + (cond ((get-buffer-window buffer) + t) + ((>= (window-height) (+ ascii-window-size ascii-window-size)) + (set-window-buffer + (split-window nil (- (window-height) ascii-window-size)) + buffer) + t) + (t + (ascii-off) + (message "Window height too small for ASCII window.") + (ding) + nil) + ) + ;; adjust overlay + (let ((code (ascii-code code 'mess)) + (window (get-buffer-window ascii-buffer-name)) + (old-window (selected-window))) + (save-excursion + (and window + (select-window window)) + (set-buffer ascii-buffer-name) + (let ((pos (aref ascii-position code)) + beg end) + (goto-char (point-min)) + (forward-line (1- (aref pos 0))) + (if (and (> code 127) (/= ascii-charset-base 127)) + (save-match-data + (re-search-forward + (format "\\\\%o %d %x \\(\\\\..\\)?." + code code code) + nil t) + (setq beg (match-beginning 0) + end (match-end 0))) + (let ((here (point)) + (bias (* (aref pos 3) ascii-sep-len))) + (setq end (+ (aref pos 2) here bias) + beg (+ (aref pos 1) here bias)))) + (if ascii-overlay + (move-overlay ascii-overlay beg end) + (setq ascii-overlay (make-overlay beg end))) + (overlay-put ascii-overlay 'face (if ascii-p + ascii-ascii-face + ascii-non-ascii-face)))) + (select-window old-window))) + mess)) + + +(defvar ascii-mark-display-code nil) +(defvar ascii-vector-code (make-vector 256 t)) + + +(defun ascii-display-code (code) + (or (eq ascii-mark-display-code ascii-display-code) + (let ((lis ascii-display-code) + (char 0) + end) + (setq ascii-mark-display-code ascii-display-code) + ;; turn off all `ascii-vector-code' + (while (<= char 255) + (aset ascii-vector-code char nil) + (setq char (1+ char))) + ;; turn on valid ranges + (while lis + (setq char (car lis) + lis (cdr lis) + end (cdr char) + char (car char)) + (and (<= 0 end) (<= end 255) + (<= 0 char) (<= char 255) + (while (<= char end) + (aset ascii-vector-code char t) + (setq char (1+ char))))))) + (aref ascii-vector-code code)) + + +(defun ascii-get-buffer (code) + (let ((base (- (following-char) (- code 127)))) + (or (if (= ascii-charset-base base) + (get-buffer ascii-buffer-name) + (setq ascii-charset-base base) + (let ((buffer (get-buffer ascii-buffer-name))) + (when buffer + (delete-windows-on buffer) + (kill-buffer buffer))) + nil) + (save-excursion + (save-match-data + (prog1 + ;; create buffer + (set-buffer (get-buffer-create ascii-buffer-name)) + (set-buffer-multibyte t) + (setq buffer-read-only nil + ascii-sep-len (1- (length ascii-table-separator))) + (erase-buffer) + ;; insert ascii table + (insert ascii-table) + (goto-char (point-min)) + (or (= base 127) + (save-excursion + (let ((char 127)) + ;; characters from 128 to 159 + (while (< (setq char (1+ char)) 160) + (when (search-forward + (format "\\%o %d %x " char char char) + nil t) + (delete-char 4) + (setq base (1+ base)) + (if (not (characterp base)) + (insert "? ") + (insert base) + (let ((cols (- (current-column) + (progn + (forward-char -1) + (current-column))))) + (when (< cols 4) + (forward-char 1) + (insert (cond ((= cols 3) " ") + ((= cols 2) " ") + (t " ") + ))))))) + ;; characters from 160 to 255 + (setq char (1- char)) + (while (< (setq char (1+ char)) 256) + (goto-char (point-min)) + (when (search-forward + (format "\\%o %d %x " char char char) + nil t) + (delete-char 1) + (setq base (1+ base)) + (if (not (characterp base)) + (insert "?") + (insert base) + (let ((cols (- (current-column) + (progn + (forward-char -1) + (current-column))))) + (when (> cols 1) + (forward-char 1) + (or (equal (following-char) ?\n) + (delete-char 1)))))))))) + ;; adjust column table separator + (save-excursion + (while (search-forward "||" nil t) + (replace-match ascii-table-separator t t))) + ;; adjust header separator + (let ((spaces (make-string (1+ ascii-sep-len) ?\ ))) + (save-excursion + (while (search-forward "|-" nil t) + (replace-match spaces t t)))) + (set-buffer-modified-p nil) + (setq buffer-read-only t))))))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + +(provide 'ascii) + + +;;; ascii.el ends here diff --git a/elisp/emacs-goodies-el/auto-fill-inhibit.el b/elisp/emacs-goodies-el/auto-fill-inhibit.el new file mode 100755 index 0000000..a2b5f81 --- /dev/null +++ b/elisp/emacs-goodies-el/auto-fill-inhibit.el @@ -0,0 +1,89 @@ +;;; auto-fill-mode-inhibit -- finer grained control over +;;; auto-fill-mode (de)activation +;;; Copyright (c) 2003 Michael Weber +;; + +;;; Version: 20030509 +;; + +;;; License: +;; +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; version 2 as published by the Free Software Foundation. +;; +;; 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 +;; +;; NO-VIRUS CLAUSE: +;; The intent of this license is to protect free redistribution and +;; reuse of the source of the licensed distribution, not to prejudice +;; the authorship rights of programmers of other code to control +;; their original inventions. +;; +;; No portion of this license is to be interpreted as forbidding the +;; reuse of this code or its constituent parts, algorithms, or +;; inventions in commercial products. +;; +;; Nor shall such inclusion be construed to require the GPLing or +;; disclosure of any portions of said commercial products other than +;; those falling under the copyright of the licensed distribution. +;; + +;;; Commentary: +;; +;; To activate auto-fill-mode, add the following line to your Emacs +;; initialization: +;; (add-hook 'text-mode-hook 'turn-on-auto-fill) + +;;; History: +;; +;; 20030509: +;; * activate advice through `defadvice' instead of call to +;; `ad-activate' +;; * emit message if `auto-fill-mode' gets inhibited +;; * add (provide) line +;; * make `auto-fill-inhibit-list' a `defcustom' +;; * fixed docstrings to make M-x checkdoc happy +;; (thanks to psg@debian.org for hints) +;; +;; 20011114: +;; * Initial Version + +;;; Code: +(defcustom auto-fill-inhibit-list nil + "regexep LIST to match against buffer-name to inhibit auto-fill-mode. +An empty list of regexps (the default) retains the original +`auto-fill-mode' behaviour." + :require 'auto-fill-inhibit + :type '(repeat (regexp :tag "Buffer name regexp"))) + +(defadvice auto-fill-mode (before auto-fill-mode-inhibit activate) + "Turn off `auto-fill-mode' on matching buffers. +Buffers which have their names `string-match' on any one regexp in +`auto-fill-inhibit-list'. Unless something is put into this variable, +it behaves transparently to default auto-fill functionality." + + (let ((bufname (buffer-name))) + (if (catch 'match + (mapcar (function (lambda (s) + (if (string-match s bufname) + (throw 'match t)))) + auto-fill-inhibit-list) + nil) + (progn + (message "auto-fill-mode inhibited for this buffer through auto-fill-inhibit-list") + ;;; turn off auto-fill-mode (setting arg0 to `0') + (ad-set-arg 0 0))))) + + +(provide 'auto-fill-inhibit) + +;;; auto-fill-inhibit.el ends here diff --git a/elisp/emacs-goodies-el/bar-cursor.el b/elisp/emacs-goodies-el/bar-cursor.el new file mode 100755 index 0000000..698c671 --- /dev/null +++ b/elisp/emacs-goodies-el/bar-cursor.el @@ -0,0 +1,187 @@ +;;; @(#) bar-cursor.el -- package used to switch block cursor to a bar +;;; @(#) $Id: bar-cursor.el,v 1.2 2013/12/04 22:32:10 psg Exp $ + +;; This file is not part of Emacs + +;; Copyright (C) 2001 by Joseph L. Casadonte Jr. +;; Author: Joe Casadonte (emacs@northbound-train.com) +;; Maintainer: Joe Casadonte (emacs@northbound-train.com) +;; Created: July 1, 2001 +;; Keywords: bar cursor overwrite +;; Latest Version: http://www.northbound-train.com/emacs.html + +;; COPYRIGHT NOTICE + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: +;; +;; Simple package to convert the block cursor into a bar cursor. In +;; overwrite mode, the bar cursor changes back into a block cursor. +;; This is a quasi-minor mode, meaning that it can be turned on & off +;; easily though only globally (hence the quasi-) + +;;; Installation: +;; +;; Put this file on your Emacs-Lisp load path and add the following to +;; your ~/.emacs startup file +;; +;; (require 'bar-cursor) +;; (bar-cursor-mode 1) +;; +;; To add a directory to your load-path, use something like the following: +;; +;; (add-to-list 'load-path (expand-file-name "/some/load/path")) + +;;; Usage: +;; +;; M-x `bar-cursor-mode' +;; Toggles bar-cursor-mode on & off. Optional arg turns +;; bar-cursor-mode on iff arg is a positive integer. + +;;; To Do: +;; +;; o Nothing, at the moment. + +;;; Credits: +;; +;; The basis for this code comes from Steve Kemp by way of the +;; NTEmacs mailing list. + +;;; Comments: +;; +;; Any comments, suggestions, bug reports or upgrade requests are welcome. +;; Please send them to Joe Casadonte (emacs@northbound-train.com). +;; +;; This version of bar-cursor was developed and tested with NTEmacs +;; 20.7.1 under Windows 2000 & NT 4.0 and Emacs 20.7.1 under Linux +;; (RH7). Please, let me know if it works with other OS and versions +;; of Emacs. + +;;; Change Log: +;; +;; see http://www.northbound-train.com/emacs/bar-cursor.log + +;;; ************************************************************************** +;;; ************************************************************************** +;;; ************************************************************************** +;;; ************************************************************************** +;;; ************************************************************************** +;;; Code: + +(eval-when-compile + ;; silence the old byte-compiler + (defvar byte-compile-dynamic nil) + (set (make-local-variable 'byte-compile-dynamic) t)) + +;;; ************************************************************************** +;;; ***** version related routines +;;; ************************************************************************** +(defconst bar-cursor-version + "$Revision: 1.2 $" + "Version number for 'bar-cursor' package.") + +;; --------------------------------------------------------------------------- +(defun bar-cursor-version-number () + "Return 'bar-cursor' version number." + (string-match "[0123456789.]+" bar-cursor-version) + (match-string 0 bar-cursor-version)) + +;; --------------------------------------------------------------------------- +(defun bar-cursor-display-version () + "Display 'bar-cursor' version." + (interactive) + (message "bar-cursor version <%s>." (bar-cursor-version-number))) + +;;; ************************************************************************** +;;; ***** real functions +;;; ************************************************************************** +(defvar bar-cursor-mode nil "Non-nil if 'bar-cursor-mode' is enabled.") + +;;; -------------------------------------------------------------------------- +;;;###autoload +(defun bar-cursor-mode (&optional arg) + "Toggle use of 'bar-cursor-mode'. + +This quasi-minor mode changes cursor to a bar cursor in insert mode, +and a block cursor in overwrite mode. It may only be turned on and +off globally, not on a per-buffer basis (hence the quasi- designation). + +Optional ARG turns mode on iff ARG is a positive integer." + (interactive "P") + + ;; toggle on and off + (let ((old-mode bar-cursor-mode)) + (setq bar-cursor-mode + (if arg (or (listp arg) + (> (prefix-numeric-value arg) 0)) + (not bar-cursor-mode))) + + (when (not (equal old-mode bar-cursor-mode)) + ;; enable/disable advice + (if bar-cursor-mode + (ad-enable-advice 'overwrite-mode 'after 'bar-cursor-overwrite-mode-ad) + (ad-disable-advice 'overwrite-mode 'after 'bar-cursor-overwrite-mode-ad)) + + (ad-activate 'overwrite-mode) + + ;; set the initial cursor type now + (bar-cursor-set-cursor) + + ;; add or remove to frame hook + (if bar-cursor-mode + (add-hook 'after-make-frame-functions 'bar-cursor-set-cursor) + (remove-hook 'after-make-frame-functions 'bar-cursor-set-cursor)) + ))) + +;;;-------------------------------------------------------------------------- +(defadvice overwrite-mode (after bar-cursor-overwrite-mode-ad disable) + "Advice that controls what type of cursor is displayed." + (bar-cursor-set-cursor)) + +;;;-------------------------------------------------------------------------- +(defun bar-cursor-set-cursor-type (cursor &optional frame) + "Set the cursor-type for the named frame. + +CURSOR is the name of the cursor to use (bar or block -- any others?). +FRAME is optional frame to set the cursor for; current frame is used +if not passed in." + (interactive) + (if (not frame) + (setq frame (selected-frame))) + + ;; Do the modification. + (modify-frame-parameters frame + (list (cons 'cursor-type cursor)))) + +;;; -------------------------------------------------------------------------- +(defun bar-cursor-set-cursor (&optional frame) + "Set the cursor-type according to the insertion mode. + +FRAME is optional frame to set the cursor for; current frame is used +if not passed in." + (if (and bar-cursor-mode (not overwrite-mode)) + (bar-cursor-set-cursor-type 'bar frame) + (bar-cursor-set-cursor-type 'block frame))) + +;;; ************************************************************************** +;;; ***** we're done +;;; ************************************************************************** +(provide 'bar-cursor) + +;;; bar-cursor.el ends here +;;; ************************************************************************** +;;;; ***** EOF ***** EOF ***** EOF ***** EOF ***** EOF ************* diff --git a/elisp/emacs-goodies-el/bm.el b/elisp/emacs-goodies-el/bm.el new file mode 100755 index 0000000..c5a4818 --- /dev/null +++ b/elisp/emacs-goodies-el/bm.el @@ -0,0 +1,1342 @@ +;;; bm.el --- Visible bookmarks in buffer. + +;; Copyrigth (C) 2000-2010 Jo Odland + +;; Author: Jo Odland +;; Version: $Id: bm.el,v 1.2 2010-05-05 13:27:50 psg Exp $ +;; Keywords; bookmark, highlight, faces, persistent +;; URL: http://www.nongnu.org/bm/ +;; Project page: https://savannah.nongnu.org/projects/bm/ + +;; Portions Copyright (C) 2002 by Ben Key +;; Updated by Ben Key on 2002-12-05 +;; to add support for XEmacs + + +;; 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; either version 2, or (at +;; your option) any later version. + +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +;;; Commentary: + +;;; Description: +;; +;; This package was created because I missed the bookmarks from M$ +;; Visual Studio. I find that they provide an easy way to navigate +;; in a buffer. +;; +;; bm.el provides visible, buffer local, bookmarks and the ability +;; to jump forward and backward to the next bookmark. +;; +;; Features: +;; - Toggle bookmarks with `bm-toggle' and navigate forward and +;; backward in buffer with `bm-next' and `bm-previous'. +;; +;; - Different wrapping modes, see `bm-wrap-search' and `bm-wrap-immediately'. +;; Use `bm-toggle-wrapping' to turn wrapping on/off. Wrapping is only available +;; when `bm-cycle-all-buffers' is nil. +;; +;; - Navigate between bookmarks only in current buffer or cycle through all buffers. +;; Use `bm-cycle-all-buffers' to enable looking for bookmarks across all open buffers. +;; When cycling through bookmarks in all open buffers, the search will always wrap around. +;; +;; - Setting bookmarks based on a regexp, see `bm-bookmark-regexp' and +;; `bm-bookmark-regexp-region'. +;; +;; - Setting bookmark based on line number, see `bm-bookmark-line'. +;; +;; - Goto line position or start of line, see `bm-goto-position'. +;; +;; - Persistent bookmarks (see below). Use `bm-toggle-buffer-persistence' +;; to enable/disable persistent bookmarks (buffer local). +;; +;; - List bookmarks with annotations and context in a separate buffer, +;; see `bm-show' (current buffer) and `bm-show-all' (all buffers). +;; +;; - Remove all bookmarks in current buffer with `bm-remove-all-current-buffer' and +;; all bookmarks in all open buffers with `bm-remove-all-all-buffers'. +;; +;; - Annotate bookmarks, see `bm-bookmark-annotate' and `bm-bookmark-show-annotation'. +;; The annotation is displayed in the messsage area when navigating to a bookmark. +;; Set the variable `bm-annotate-on-create' to t to be prompted for an annotation +;; when bookmark is created. +;; +;; - Different bookmark styles, fringe-only, line-only or both, +;; see `bm-highlight-style'. It is possible to have fringe-markers on left or right side. +;; + + +;;; Known limitations: +;; +;; This package is developed and testet on GNU Emacs 22.x. It should +;; work on all GNU Emacs 21.x, GNU Emacs 23.x and also on XEmacs +;; 21.x with some limitations. +;; +;; There are some incompabilities with lazy-lock when using +;; fill-paragraph. All bookmark below the paragraph being filled +;; will be lost. This issue can be resolved using the `jit-lock-mode' +;; introduced in GNU Emacs 21.1 +;; + + +;;; Installation: +;; +;; To use bm.el, put it in your load-path and add +;; the following to your .emacs +;; +;; (require 'bm) +;; +;; or +;; +;; (autoload 'bm-toggle "bm" "Toggle bookmark in current buffer." t) +;; (autoload 'bm-next "bm" "Goto bookmark." t) +;; (autoload 'bm-previous "bm" "Goto previous bookmark." t) +;; + + +;;; Configuration: +;; +;; To make it easier to use, assign the commands to some keys. +;; +;; M$ Visual Studio key setup. +;; (global-set-key (kbd "") 'bm-toggle) +;; (global-set-key (kbd "") 'bm-next) +;; (global-set-key (kbd "") 'bm-previous) +;; +;; Click on fringe to toggle bookmarks, and use mouse wheel to move +;; between them. +;; (global-set-key (kbd " ") 'bm-next-mouse) +;; (global-set-key (kbd " ") 'bm-previous-mouse) +;; (global-set-key (kbd " ") 'bm-toggle-mouse) +;; +;; If you would like the markers on the right fringe instead of the +;; left, add the following to line: +;; +;; (setq bm-marker 'bm-marker-right) +;; + + + +;;; Persistence: +;; +;; Bookmark persistence is achieved by storing bookmark data in a +;; repository when a buffer is killed. The repository is saved to +;; disk on exit. See `bm-repository-file'. The maximum size of the +;; repository is controlled by `bm-repository-size'. +;; +;; The buffer local variable `bm-buffer-persistence' decides if +;; bookmarks in a buffer is persistent or not. Non-file buffers +;; can't have persistent bookmarks, except for *info* and +;; indirect buffers. +;; +;; Bookmarks are non-persistent as default. To have bookmarks +;; persistent as default add the following line to .emacs. +;; +;; ;; make bookmarks persistent as default +;; (setq-default bm-buffer-persistence t) + +;; Use the function `bm-toggle-buffer-persistence' to toggle +;; bookmark persistence. +;; +;; To have automagic bookmark persistence we need to add some +;; functions to the following hooks. Insert the following code +;; into your .emacs file: +;; +;; If you are using desktop or other packages that restore buffers +;; on start up, bookmarks will not be restored. When using +;; `after-init-hook' to restore the repository, it will be restored +;; *after* .emacs is finished. To load the repository when bm is +;; loaded set the variable `bm-restore-repository-on-load' to t, +;; *before* loading bm (and don't use the `after-init-hook'). +;; +;; ;; Make sure the repository is loaded as early as possible +;; (setq bm-restore-repository-on-load t) +;; (require 'bm) +;; +;; ;; Loading the repository from file when on start up. +;; (add-hook' after-init-hook 'bm-repository-load) +;; +;; ;; Restoring bookmarks when on file find. +;; (add-hook 'find-file-hooks 'bm-buffer-restore) +;; +;; ;; Saving bookmark data on killing a buffer +;; (add-hook 'kill-buffer-hook 'bm-buffer-save) +;; +;; ;; Saving the repository to file when on exit. +;; ;; kill-buffer-hook is not called when Emacs is killed, so we +;; ;; must save all bookmarks first. +;; (add-hook 'kill-emacs-hook '(lambda nil +;; (bm-buffer-save-all) +;; (bm-repository-save))) +;; +;; ;; Update bookmark repository when saving the file. +;; (add-hook 'after-save-hook 'bm-buffer-save) +;; +;; ;; Restore bookmarks when buffer is reverted. +;; (add-hook 'after-revert-hook 'bm-buffer-restore) +;; +;; +;; The `after-save-hook' and `after-revert-hook' is not necessary to +;; use to achieve persistence, but it makes the bookmark data in +;; repository more in sync with the file state. +;; +;; The `after-revert-hook' might cause trouble when using packages +;; that automatically reverts the buffer (like vc after a check-in). +;; This can easily be avoided if the package provides a hook that is +;; called before the buffer is reverted (like `vc-before-checkin-hook'). +;; Then new bookmarks can be saved before the buffer is reverted. +;; +;; ;; make sure bookmarks is saved before check-in (and revert-buffer) +;; (add-hook 'vc-before-checkin-hook 'bm-buffer-save) + + + +;;; Acknowledgements: +;; +;; - The use of overlays for bookmarks was inspired by highline.el by +;; Vinicius Jose Latorre . +;; - Thanks to Ben Key for XEmacs support. +;; - Thanks to Peter Heslin for notifying me on the incompability with +;; lazy-lock. +;; - Thanks to Christoph Conrad for adding support for goto line position +;; in bookmarks and simpler wrapping. +;; - Thanks to Jan Rehders for adding support for different bookmark styles. +;; - Thanks to Dan McKinley for inspiration to add support +;; for listing bookmarks in all buffers, `bm-show-all'. +;; (http://www.emacswiki.org/cgi-bin/wiki/bm-ext.el) +;; - Thanks to Jonathan Kotta for mouse support and fringe +;; markers on left or right side. + + +;;; Change log: + +;; Changes in 1.43 +;; - Fixed spelling. Thanks to Juanma Barranquero for patch. +;; +;; Changes in 1.42 +;; - Fixed bug(#29536) - Next/previous does not wrap when `bm-cycle-all-buffers' t +;; and only bookmarks in one buffer. +;; +;; Changes in 1.41 +;; - Updated documentation to satisfy `checkdoc'. +;; +;; Changes in 1.38 +;; - Added support for bookmark search across buffers. See `bm-cycle-all-buffers'. +;; - Added support for mouse navigation (#28863). See `bm-toggle-mouse', `bm-next-mouse' +;; and `bm-previous-mouse'. +;; - Added support for markers on the right fringe (#28863). +;; +;; Changes in 1.36 +;; - Added support for persistent bookmarks in non-file buffers (Info buffers, indirect-buffers). +;; - Fixed bug(#26077) - bm asks for annotation when restoring bookmarks for bookmarks which +;; already have an annotation. +;; +;; Changes in 1.35 +;; - Added utf-8 encoding on `bm-repository-file' +;; - Removed compile check on fringe support. +;; +;; Changes in 1.34 +;; - Added support for bookmarks in fringe (Patch from Jan Rehders ) +;; - Fixed bugs with `bm-next', `bm-previous' and `bm-goto'. +;; - Removed line format variables, `bm-show-header-string' and `bm-show-format-string'. +;; - Added `bm-show-all' for displaying bookmarks in all buffers. +;; +;; Changes in 1.32 +;; - Added change log. +;; +;; Changes in 1.31 +;; - Renamed function `bm-extract' to `bm-show' +;; - Fixed annotation bug in `bm-bookmark-regexp-region'. +;; +;; Changes in 1.30 +;; - New format on file repository. +;; - Support for annotation of bookmarks. See variable `bm-annotate-on-create', +;; `bm-bookmark-annotate' and `bm-bookmark-show-annotation'. +;; - Added context to help restoring bookmarks correctly, +;; see `bm-bookmark-context-size'. +;; - Renamed function `bm-repository-empty' to `bm-repositoty-clear'. +;; + + +;;; Todo: +;; +;; - Prevent the bookmark (overlay) from being extended when +;; inserting (before, inside or after) the bookmark in XEmacs. This +;; is due to the missing support for overlay hooks i XEmacs. +;; + + +;;; Code: +;; + +(eval-and-compile + ;; avoid compile waring on unbound variable + (require 'info) + + ;; xemacs needs overlay emulation package + (unless (fboundp 'overlay-lists) + (require 'overlay))) + + +(defconst bm-version "$Id: bm.el,v 1.2 2010-05-05 13:27:50 psg Exp $" + "CVS version of bm.el.") + +(defconst bm-bookmark-repository-version 2 + "The repository version.") + +(defgroup bm nil + "Visible, buffer local bookmarks." + :link '(emacs-library-link :tag "Source Lisp File" "bm.el") + :group 'faces + :group 'editing + :prefix "bm-") + +(defcustom bm-highlight-style 'bm-highlight-only-line + "*Specify how bookmars are highlighted." + :type '(choice (const bm-highlight-only-line) + (const bm-highlight-only-fringe) + (const bm-highlight-line-and-fringe)) + :group 'bm) + +(defcustom bm-face 'bm-face + "*Specify face used to highlight the current line." + :type 'face + :group 'bm) + + +(defcustom bm-persistent-face 'bm-persistent-face + "*Specify face used to highlight the current line for persistent bookmarks." + :type 'face + :group 'bm) + +(defcustom bm-priority 0 + "*Specify bm overlay priority. + +Higher integer means higher priority, so bm overlay will have precedence +over overlays with lower priority. *Don't* use negative number." + :type 'integer + :group 'bm) + + +(defface bm-face + '((((class grayscale) + (background light)) (:background "DimGray")) + (((class grayscale) + (background dark)) (:background "LightGray")) + (((class color) + (background light)) (:foreground "White" :background "DarkOrange1")) + (((class color) + (background dark)) (:foreground "Black" :background "DarkOrange1"))) + "Face used to highlight current line." + :group 'bm) + + +(defface bm-persistent-face + '((((class grayscale) + (background light)) (:background "DimGray")) + (((class grayscale) + (background dark)) (:background "LightGray")) + (((class color) + (background light)) (:foreground "White" :background "DarkBlue")) + (((class color) + (background dark)) (:foreground "White" :background "DarkBlue"))) + "Face used to highlight current line if bookmark is persistent." + :group 'bm) + + +(defcustom bm-fringe-face 'bm-fringe-face + "*Specify face used to highlight the fringe." + :type 'face + :group 'bm) + +(defcustom bm-fringe-persistent-face 'bm-fringe-persistent-face + "*Specify face used to highlight the fringe for persistent bookmarks." + :type 'face + :group 'bm) + +(defface bm-fringe-face + '((((class grayscale) + (background light)) (:background "DimGray")) + (((class grayscale) + (background dark)) (:background "LightGray")) + (((class color) + (background light)) (:foreground "White" :background "DarkOrange1")) + (((class color) + (background dark)) (:foreground "Black" :background "DarkOrange1"))) + "Face used to highlight bookmarks in the fringe." + :group 'bm) + +(defface bm-fringe-persistent-face + '((((class grayscale) + (background light)) (:background "DimGray")) + (((class grayscale) + (background dark)) (:background "LightGray")) + (((class color) + (background light)) (:foreground "White" :background "DarkBlue")) + (((class color) + (background dark)) (:foreground "White" :background "DarkBlue"))) + "Face used to highlight bookmarks in the fringe if bookmark is persistent." + :group 'bm) + + +(defcustom bm-annotate-on-create nil + "*Specify if bookmarks must be annotated when created. + +nil, don't ask for an annotation when creating a bookmark. +t, always ask for annotation when creating a bookmark." + :type 'boolean + :group 'bm) + + +(defcustom bm-wrap-search t + "*Specify if bookmark search should wrap. + +nil, don't wrap when there are no more bookmarks. +t, wrap." + :type 'boolean + :group 'bm) + + +(defcustom bm-wrap-immediately t + "*Specify if a wrap should be announced or not. +Only has effect when `bm-wrap-search' is t. + +nil, announce before wrapping. +t, don't announce." + :type 'boolean + :group 'bm) + +(defcustom bm-cycle-all-buffers nil + "*Specify if bookmark search is done across buffers. +This will ignore the `bm-wrap-search' setting. + +nil, only search in current buffer. +t, search in all open buffers." + :type 'boolean + :group 'bm) + +(defcustom bm-recenter nil + "*Specify if the buffer should be recentered after jumping to a bookmark." + :type 'boolean + :group 'bm) + + +(defcustom bm-goto-position t + "*Specify the position, on line, to go to when jumping to a bookmark. + +nil, goto start of line. +t, goto position on the line where the bookmark was set." + :type 'boolean + :group 'bm) + + +(defcustom bm-repository-file (expand-file-name "~/.bm-repository") + "*Filename to store persistent bookmarks across sessions. + +nil, the repository will not be persistent." + :type 'string + :group 'bm) + + +(defcustom bm-repository-size 100 + "*Size of persistent repository. If nil then there if no limit." + :type 'integer + :group 'bm) + + +(defcustom bm-buffer-persistence nil + "*Specify if bookmarks in a buffer should be persistent. +Buffer local variable. + +nil, don't save bookmarks. +t, save bookmarks." + :type 'boolean + :group 'bm) +(make-variable-buffer-local 'bm-buffer-persistence) + + +(defcustom bm-restore-on-mismatch nil + "*Specify if bookmarks should be restored if there is a buffer size mismatch. +DEPRECATED: Only in use for version 1 of repository. + +nil, don't restore. +t, restore if possible." + :type 'boolean + :group 'bm) + + +(defvar bm-restore-repository-on-load nil + "Specify if repository should be restored when loading bm. + +nil, don't restore repository on load. +t, restore repository when this file is loaded. This must be set +before bm is loaded.") + +(defvar bm-repository nil + "Alist with all persistent bookmark data.") + +(defvar bm-regexp-history nil + "Bookmark regexp history.") + +(defvar bm-annotation-history nil + "Bookmark annotation history.") + +(defvar bm-bookmark-context-size 16 + "The size of context stored, before and after, for each bookmark.") + +(defvar bm-wrapped nil + "State variable to support wrapping.") +(make-variable-buffer-local 'bm-wrapped) + +(defvar bm-marker 'bm-marker-left + "Fringe marker side. Left of right.") + +(define-fringe-bitmap 'bm-marker-left [#x00 #x00 #xFC #xFE #x0F #xFE #xFC #x00]) +(define-fringe-bitmap 'bm-marker-right [#x00 #x00 #x3F #x7F #xF0 #x7F #x3F #x00]) + + +(defun bm-customize nil + "Customize bm group." + (interactive) + (customize-group 'bm)) + + +(defun bm-bookmark-annotate (&optional bookmark annotation) + "Annotate bookmark at point or the BOOKMARK specified as parameter. + +If ANNOTATION is provided use this, and not prompt for input." + (interactive) + (if (null bookmark) + (setq bookmark (bm-bookmark-at (point)))) + + (if (bm-bookmarkp bookmark) + (progn + (if (null annotation) + (setq annotation (read-from-minibuffer "Annotation: " nil nil nil 'bm-annotation-history))) + (overlay-put bookmark 'annotation annotation)) (if (interactive-p) (message "No bookmark at point")))) + + +(defun bm-bookmark-show-annotation (&optional bookmark) + "Show annotation for bookmark. +Either the bookmark at point or the BOOKMARK specified as parameter." + (interactive) + (if (null bookmark) + (setq bookmark (bm-bookmark-at (point)))) + + (if (bm-bookmarkp bookmark) + (progn + (let ((annotation (overlay-get bookmark 'annotation))) + (if annotation + (message annotation) + (message "No annotation for current bookmark.")))) + (message "No bookmark at current line."))) + +(defun bm-line-highlighted () + "Test if line is highlighted." + (or (equal bm-highlight-style 'bm-highlight-only-line) + (equal bm-highlight-style 'bm-highlight-line-and-fringe))) + +(defun bm-fringe-highlighted () + "Test if fringe is highlighted." + (or (equal bm-highlight-style 'bm-highlight-only-fringe) + (equal bm-highlight-style 'bm-highlight-line-and-fringe))) + +(defun bm-bookmark-add (&optional annotation) + "Add bookmark at current line. + +If ANNOTATION is provided use this, and do not prompt for input. +Only used if `bm-annotate-on-create' is true. + +Do nothing if bookmark is present." + (if (bm-bookmark-at (point)) + nil ; bookmark exists + (let ((bookmark (make-overlay (bm-start-position) (bm-end-position))) + (hlface (if bm-buffer-persistence bm-persistent-face bm-face)) + (hlface-fringe (if bm-buffer-persistence bm-fringe-persistent-face bm-fringe-face))) + ;; set market + (overlay-put bookmark 'position (point-marker)) + ;; select bookmark face + (when (bm-line-highlighted) + (overlay-put bookmark 'face hlface)) + (overlay-put bookmark 'evaporate t) + (overlay-put bookmark 'category 'bm) + (when (bm-fringe-highlighted) + (let* ((marker-string "*fringe-dummy*") + (marker-length (length marker-string))) + (put-text-property 0 marker-length 'display + (list (if (eq bm-marker 'bm-marker-left) + 'left-fringe + 'right-fringe) + bm-marker hlface-fringe) + marker-string) + (overlay-put bookmark 'before-string marker-string))) + (if (or bm-annotate-on-create annotation) + (bm-bookmark-annotate bookmark annotation)) + (unless (featurep 'xemacs) + ;; gnu emacs specific features + (overlay-put bookmark 'priority bm-priority) + (overlay-put bookmark 'modification-hooks '(bm-freeze)) + (overlay-put bookmark 'insert-in-front-hooks '(bm-freeze-in-front)) + (overlay-put bookmark 'insert-behind-hooks '(bm-freeze))) + bookmark))) + + +(defun bm-bookmark-remove (&optional bookmark) + "Remove bookmark at point or the BOOKMARK specified as parameter." + (if (null bookmark) + (setq bookmark (bm-bookmark-at (point)))) + + (if (bm-bookmarkp bookmark) + (delete-overlay bookmark))) + + +;;;###autoload +(defun bm-toggle nil + "Toggle bookmark at point." + (interactive) + (let ((bookmark (bm-bookmark-at (point)))) + (if bookmark + (bm-bookmark-remove bookmark) + (bm-bookmark-add)))) + + +;;;###autoload +(defun bm-toggle-mouse (ev) + "Toggle a bookmark with a mouse click. +EV is the mouse event." + (interactive "e") + (save-excursion + (mouse-set-point ev) + (bm-toggle))) + + +(defun bm-count nil + "Count the number of bookmarks in buffer." + (let ((bookmarks (bm-lists))) + (+ (length (car bookmarks)) (length (cdr bookmarks))))) + + +(defun bm-start-position nil + "Return the bookmark start position." + (point-at-bol)) + + +(defun bm-end-position nil + "Return the bookmark end position." + (min (point-max) (+ 1 (point-at-eol)))) + + +(defun bm-freeze-in-front (overlay after begin end &optional len) + "Prevent overlay from being extended to multiple lines. +When inserting in front of overlay move overlay forward. + +OVERLAY the overlay being modified. +AFTER nil when called before, t when called after modification. +BEGIN the beginning of the text being modified. +END the end of the text being modified. +When called after, the length of the modification is passed as LEN. + +See Overlay Properties in the Emacs manual for more information: +http://www.gnu.org/s/emacs/manual/html_node/elisp/Overlay-Properties.html" + (if after + (move-overlay overlay (bm-start-position) (bm-end-position)))) + + +(defun bm-freeze (overlay after begin end &optional len) + "Prevent OVERLAY from being extended to multiple lines. +When inserting inside or behind the overlay, keep the original start postion. + +OVERLAY the overlay being modified. +AFTER nil when called before, t when called after modification. +BEGIN the beginning of the text being modified. +END the end of the text being modified. +When called after, the length of the modification is passed as LEN. + +See Overlay Properties in the Emacs manual for more information: +http://www.gnu.org/s/emacs/manual/html_node/elisp/Overlay-Properties.html" + (if after + (let ((bm-start (overlay-start overlay))) + (if bm-start + (move-overlay overlay + bm-start + (save-excursion + (goto-char bm-start) + (bm-end-position))))))) + + +(defun bm-equal (first second) + "Compare two bookmarks. Return t if FIRST is equal to SECOND." + (if (and (bm-bookmarkp first) (bm-bookmarkp second)) + (= (overlay-start first) (overlay-start second)) + nil)) + + +(defun bm-bookmarkp (bookmark) + "Return the BOOKMARK if overlay is a bookmark." + (if (and (overlayp bookmark) + (string= (overlay-get bookmark 'category) "bm")) + bookmark + nil)) + + +(defun bm-bookmark-at (point) + "Get bookmark at POINT." + (let ((overlays (overlays-at point)) + (bookmark nil)) + (while (and (not bookmark) overlays) + (if (bm-bookmarkp (car overlays)) + (setq bookmark (car overlays)) + (setq overlays (cdr overlays)))) + bookmark)) + + +(defun bm-lists (&optional direction) + "Return a pair of lists giving all the bookmarks of the current buffer. +The car has all the bookmarks before the overlay center; +the cdr has all the bookmarks after the overlay center. +A bookmark implementation of `overlay-list'. + +If optional argument DIRECTION is provided, only return bookmarks +in the specified direction." + (overlay-recenter (point)) + (cond ((equal 'forward direction) + (cons nil (remq nil (mapcar 'bm-bookmarkp (cdr (overlay-lists)))))) + ((equal 'backward direction) + (cons (remq nil (mapcar 'bm-bookmarkp (car (overlay-lists)))) nil)) + (t + (cons (remq nil (mapcar 'bm-bookmarkp (car (overlay-lists)))) + (remq nil (mapcar 'bm-bookmarkp (cdr (overlay-lists)))))))) + + +;;;###autoload +(defun bm-next nil + "Goto next bookmark." + (interactive) + (if (= (bm-count) 0) + (if bm-cycle-all-buffers + (bm-first-in-next-buffer) + (message "No bookmarks defined.")) + (let ((bm-list-forward (cdr (bm-lists 'forward)))) + ;; remove bookmark at point + (if (bm-equal (bm-bookmark-at (point)) (car bm-list-forward)) + (setq bm-list-forward (cdr bm-list-forward))) + + (if bm-list-forward + (bm-goto (car bm-list-forward)) + (cond (bm-cycle-all-buffers (bm-first-in-next-buffer)) + (bm-wrap-search (bm-wrap-forward)) + (t (message "No next bookmark."))))))) + +(defun bm-wrap-forward nil + "Goto next bookmark, wrapping." + (if (or bm-wrapped bm-wrap-immediately) + (progn + (bm-first) + (message "Wrapped.")) + (setq bm-wrapped t) ; wrap on next goto + (message "Failed: No next bookmark."))) + + +;;;###autoload +(defun bm-next-mouse (ev) + "Go to the next bookmark with the scroll wheel. +EV is the mouse event." + (interactive "e") + (let ((old-selected-window (selected-window))) + (select-window (posn-window (event-start ev))) + (bm-next) + (select-window old-selected-window))) + + +;;;###autoload +(defun bm-previous nil + "Goto previous bookmark." + (interactive) + (if (= (bm-count) 0) + (if bm-cycle-all-buffers + (bm-last-in-previous-buffer) + (message "No bookmarks defined.")) + (let ((bm-list-backward (car (bm-lists 'backward)))) + ;; remove bookmark at point + (if (bm-equal (bm-bookmark-at (point)) (car bm-list-backward)) + (setq bm-list-backward (cdr bm-list-backward))) + + (if bm-list-backward + (bm-goto (car bm-list-backward)) + + (cond (bm-cycle-all-buffers (bm-last-in-previous-buffer)) + (bm-wrap-search (bm-wrap-backward)) + (t (message "No previous bookmark."))))))) + +(defun bm-wrap-backward nil + "Goto previous bookmark, wrapping." + (if (or bm-wrapped bm-wrap-immediately) + (progn + (bm-last) + (message "Wrapped.")) + (setq bm-wrapped t) ; wrap on next goto + (message "Failed: No previous bookmark."))) + + +;;;###autoload +(defun bm-previous-mouse (ev) + "Go to the previous bookmark with the scroll wheel. +EV is the mouse event." + (interactive "e") + (let ((old-selected-window (selected-window))) + (select-window (posn-window (event-start ev))) + (bm-previous) + (select-window old-selected-window))) + + +(defun bm-first-in-next-buffer nil + "Goto first bookmark in next buffer." + (interactive) + (let ((buffers + (save-excursion + (remq nil (mapcar '(lambda (buffer) + (set-buffer buffer) + (if (> (bm-count) 0) + buffer + nil)) + ;; drop current buffer from list + (cdr (buffer-list))))))) + + (if buffers + (progn + (switch-to-buffer (car buffers)) + (message "Switched to '%s'" (car buffers)) + (bm-first)) + ;; no bookmarks found in other open buffers, + ;; wrap in current buffer? + (if bm-wrap-search + (bm-wrap-forward) + (message "No bookmarks found in other open buffers."))))) + + + +(defun bm-last-in-previous-buffer nil + "Goto last bookmark in previous buffer." + (interactive) + (let ((buffers + (save-excursion + (remq nil (mapcar '(lambda (buffer) + (set-buffer buffer) + (if (> (bm-count) 0) + buffer + nil)) + ;; drop current buffer from list + (reverse (cdr (buffer-list)))))))) + + (if buffers + (progn + (switch-to-buffer (car buffers)) + (message "Switched to '%s'" (car buffers)) + (bm-last)) + ;; no bookmarks found in other open buffers, + ;; wrap in current buffer? + (if bm-wrap-search + (bm-wrap-backward) + (message "No bookmarks found in other open buffers."))))) + + +(defun bm-first nil + "Goto first bookmark in buffer." + (goto-char (point-min)) + (if (bm-bookmark-at (point)) + ;; bookmark at beginning of buffer, stop looking + nil + (bm-next))) + + +(defun bm-last nil + "Goto first bookmark in buffer." + (goto-char (point-max)) + (if (bm-bookmark-at (point)) + ;; bookmark at end of buffer, stop looking + nil + (bm-previous))) + + +(defun bm-remove-all-all-buffers nil + "Delete all visible bookmarks in all open buffers." + (interactive) + (save-excursion + (mapcar '(lambda (buffer) + (set-buffer buffer) + (bm-remove-all-current-buffer)) + (buffer-list)))) + + +(defun bm-remove-all-current-buffer nil + "Delete all visible bookmarks in current buffer." + (interactive) + (let ((bookmarks (bm-lists))) + (mapc 'bm-bookmark-remove (append (car bookmarks) (cdr bookmarks))))) + + +(defun bm-toggle-wrapping nil + "Toggle wrapping on/off, when searching for next/previous bookmark." + (interactive) + (setq bm-wrap-search (not bm-wrap-search)) + (if bm-wrap-search + (message "Wrapping on.") + (message "Wrapping off."))) + + +(defun bm-toggle-cycle-all-buffers nil + "Toggle searching across all buffers." + (interactive) + (setq bm-cycle-all-buffers (not bm-cycle-all-buffers)) + (if bm-cycle-all-buffers + (message "Cycle all buffers on") + (message "Cycle all buffers off"))) + + +(defun bm-goto (bookmark) + "Goto specified BOOKMARK." + (if (bm-bookmarkp bookmark) + (progn + (if bm-goto-position + (goto-char (marker-position (overlay-get bookmark 'position))) + (goto-char (overlay-start bookmark))) + (setq bm-wrapped nil) ; turn off wrapped state + (if bm-recenter + (recenter)) + (let ((annotation (overlay-get bookmark 'annotation))) + (if annotation + (message annotation)))) + (message "Bookmark not found."))) + + +(defun bm-bookmark-regexp nil + "Set bookmark on lines that match regexp." + (interactive) + (bm-bookmark-regexp-region (point-min) (point-max))) + + +(defun bm-bookmark-regexp-region (beg end) + "Set bookmark on lines that match regexp in region. +Region defined by BEG and END." + (interactive "r") + (let ((regexp (read-from-minibuffer + "regexp: " nil nil nil 'bm-regexp-history)) + (annotation nil) + (count 0)) + (save-excursion + (if bm-annotate-on-create + (setq annotation (read-from-minibuffer + "Annotation: " nil nil nil 'bm-annotation-history))) + + (goto-char beg) + (while (re-search-forward regexp end t) + (bm-bookmark-add annotation) + (setq count (1+ count)) + (forward-line 1))) + (message "%d bookmark(s) created." count))) + + +(defun bm-bookmark-line (line) + "Set a bookmark on the specified LINE." + (interactive "nSet a bookmark on line: ") + (let ((lines (count-lines (point-min) (point-max)))) + (if (> line lines) + (message "Unable to set bookmark at line %d. Only %d lines in buffer." + line lines) + (goto-line line) + (bm-bookmark-add)))) + + +(defun bm-show-all nil + "Show bookmarked lines in all buffers." + (interactive) + (let ((lines + (save-excursion + (mapconcat '(lambda (buffer) + (set-buffer buffer) + (bm-show-extract-bookmarks)) + (buffer-list) "")))) + (bm-show-display-lines lines))) + + +(defun bm-show nil + "Show bookmarked lines in current buffer." + (interactive) + (bm-show-display-lines (bm-show-extract-bookmarks))) + + +(defun bm-show-extract-bookmarks nil + "Extract bookmarks from current buffer." + (let ((bookmarks (bm-lists))) + (mapconcat + '(lambda (bm) + (let ((string + (format "%-20s %-20s %s" + (format "%s:%d" (buffer-name) (count-lines (point-min) (overlay-start bm))) + (let ((annotation (overlay-get bm 'annotation))) + (if (null annotation) "" annotation)) + (buffer-substring (overlay-start bm) (overlay-end bm))))) + (put-text-property 0 (length string) 'bm-buffer (buffer-name) string) + (put-text-property 0 (length string) 'bm-bookmark bm string) + string)) + (append + ;; xemacs has the list sorted after buffer position, while + ;; gnu emacs list is sorted relative to current position. + (if (featurep 'xemacs) + (car bookmarks) + (reverse (car bookmarks))) + (cdr bookmarks)) ""))) + + +(defun bm-show-display-lines (lines) + "Show bookmarked LINES to the *bm-bookmarks* buffer." + (if (= (length lines) 0) + (message "No bookmarks defined.") + (with-output-to-temp-buffer "*bm-bookmarks*" + (set-buffer standard-output) + (insert lines) + (bm-show-mode) + (setq buffer-read-only t)))) + + +(defun bm-show-goto-bookmark nil + "Goto the bookmark on current line in the *bm-bookmarks* buffer." + (interactive) + (let ((buffer-name (get-text-property (point) 'bm-buffer)) + (bookmark (get-text-property (point) 'bm-bookmark))) + (if (null buffer-name) + (message "No bookmark at this line.") + (pop-to-buffer (get-buffer buffer-name)) + (bm-goto bookmark)))) + + +(defun bm-show-bookmark nil + "Show the bookmark on current line in the *bm-bookmarks* buffer." + (interactive) + (let ((buffer-name (get-text-property (point) 'bm-buffer)) + (bookmark (get-text-property (point) 'bm-bookmark))) + (if (null buffer-name) + (message "No bookmark at this line.") + (let ((current-buffer (current-buffer))) + (pop-to-buffer (get-buffer buffer-name)) + (bm-goto bookmark) + (pop-to-buffer current-buffer))))) + + +(defvar bm-show-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "RET") 'bm-show-goto-bookmark) + (define-key map (kbd "SPC") 'bm-show-bookmark) + map) + "Keymap for `bm-show-mode'.") + + +(defun bm-show-mode nil + "Major mode for `bm-show' buffers." + (interactive) + (kill-all-local-variables) + (setq major-mode 'bm-show-mode) + (setq mode-name "bm-bookmarks") + (use-local-map bm-show-mode-map)) + + +(defun bm-toggle-buffer-persistence nil + "Toggle if a buffer has persistent bookmarks or not." + (interactive) + (if bm-buffer-persistence + ;; turn off + (progn + (setq bm-buffer-persistence nil) + (bm-repository-remove (bm-buffer-file-name)) ; remove from repository + (message "Bookmarks in buffer are not persistent.")) + ;; turn on + (if (not (null (bm-buffer-file-name))) + (progn + (setq bm-buffer-persistence (not bm-buffer-persistence)) + (bm-buffer-save) ; add to repository + (message "Bookmarks in buffer are persistent.")) + (message "Unable to set persistent mode on a non-file buffer."))) + + ;; change color on bookmarks + (let ((bookmarks (bm-lists))) + (mapc '(lambda (bookmark) + (if bm-buffer-persistence + (overlay-put bookmark 'face bm-persistent-face) + (overlay-put bookmark 'face bm-face))) + (append (car bookmarks) (cdr bookmarks))))) + + +(defun bm-get-position-from-context (bookmark) + "Get position of BOOKMARK based on context. +If we find the context before the old bookmark we use it, +otherwise we use the context after." + (save-excursion + (let ((point nil) + (before (cdr (assoc 'before-context-string bookmark))) + (after (cdr (assoc 'after-context-string bookmark)))) + + ;; search forward for context + (if (and after (search-forward after (point-max) t)) + (progn + (goto-char (match-beginning 0)) + (setq point (point)))) + + ;; search backward for context + (if (and before (search-backward before (point-min) t)) + (progn + (goto-char (match-end 0)) + (setq point (point)))) + point))) + + +(defun bm-buffer-restore nil + "Restore bookmarks saved in the repository for the current buffer." + (interactive) + (let ((buffer-data (assoc (bm-buffer-file-name) bm-repository))) + (if buffer-data + (let ((version (cdr (assoc 'version buffer-data)))) + (cond ((= version 2) + (bm-buffer-restore-2 buffer-data)) + (t + (bm-buffer-restore-1 buffer-data)))) + (if (interactive-p) (message "No bookmarks in repository."))))) + + +(defun bm-buffer-restore-all nil + "Restore bookmarks in all buffers." + (save-current-buffer + (mapc '(lambda (buffer) + (set-buffer buffer) + (bm-buffer-restore)) + (buffer-list)))) + +(defun bm-buffer-restore-1 (buffer-data) + "Restore bookmarks from version 1 format. +BUFFER-DATA is the content of `bm-repository-file'." + (let ((buffer-size-match (equal (point-max) (cdr (assoc 'size buffer-data)))) + (positions (cdr (assoc 'positions buffer-data)))) + + ;; validate buffer size + (if (or buffer-size-match + bm-restore-on-mismatch) + ;; restore bookmarks + (let ((pos nil) + (count 0)) + + (setq bm-buffer-persistence t) ; enable persistence + (save-excursion + (while positions + (setq pos (car positions)) + + (if (and (< pos (point-min)) + (> (point-max) pos)) + nil ; outside buffer, skip bookmark + (goto-char pos) + (bm-bookmark-add) + (setq count (1+ count)) + (setq positions (cdr positions))))) + + (if buffer-size-match + (message "%d bookmark(s) restored." count) + (message "Buffersize mismatch. %d bookmarks restored." count))) + + ;; size mismatch + (bm-repository-remove (buffer-file-name)) + (message "Buffersize mismatch. No bookmarks restored.")))) + + +(defun bm-buffer-restore-2 (buffer-data) + "Restore bookmarks from version 2 format. +BUFFER-DATA is the content of `bm-repository-file'." + (let ((buffer-size-match (equal (point-max) (cdr (assoc 'size buffer-data)))) + (bookmarks (cdr (assoc 'bookmarks buffer-data)))) + + ;; restore bookmarks + (let ((pos nil) + (count 0)) + + (setq bm-buffer-persistence t) ; enable persistence + (save-excursion + (while bookmarks + (let ((pos + (if buffer-size-match + (cdr (assoc 'position (car bookmarks))) + (bm-get-position-from-context (car bookmarks)))) + (bm nil) + (annotation (cdr (assoc 'annotation (car bookmarks))))) + + (if (and (< pos (point-min)) + (> (point-max) pos)) + nil ; outside buffer, skip bookmark + (goto-char pos) + (setq bm (bm-bookmark-add annotation)) + (setq count (1+ count)) + (setq bookmarks (cdr bookmarks)))))) + + (if buffer-size-match + (message "%d bookmark(s) restored." count) + (message "%d bookmark(s) restored based on context." count))))) + + +(defun bm-buffer-save nil + "Save all bookmarks to repository." + (interactive) + (if (not (null (bm-buffer-file-name))) + (if bm-buffer-persistence + (let ((buffer-data + (list + (bm-buffer-file-name) + (cons 'version bm-bookmark-repository-version) + (cons 'size (point-max)) + (cons 'timestamp (current-time)) + (cons 'bookmarks + (let ((bookmarks (bm-lists))) + (mapcar + '(lambda (bm) + (let ((position (marker-position (overlay-get bm 'position)))) + (list + (cons 'position position) + (cons 'annotation (overlay-get bm 'annotation)) + (cons 'before-context-string + (if (>= (point-min) (- position bm-bookmark-context-size)) + nil + (buffer-substring-no-properties + (- position bm-bookmark-context-size) position))) + (cons 'after-context-string + (if (>= (+ position bm-bookmark-context-size) (point-max)) + nil + (buffer-substring-no-properties + position (+ position bm-bookmark-context-size)))) + ))) + (append (car bookmarks) (cdr bookmarks)))))))) + + ;; remove if exists + (bm-repository-remove (car buffer-data)) + + ;; add if there exists bookmarks + (let ((count (length (cdr (assoc 'bookmarks buffer-data))))) + (if (> count 0) + (bm-repository-add buffer-data)) + (if (interactive-p) + (message "%d bookmark(s) saved to repository." count)))) + + (if (interactive-p) + (message "No bookmarks saved. Buffer is not persistent."))) + + (if (interactive-p) + (message "Unable to save bookmarks in non-file buffers.")))) + + +(defun bm-buffer-save-all nil + "Save bookmarks in all buffers." + (save-current-buffer + (mapc '(lambda (buffer) + (set-buffer buffer) + (bm-buffer-save)) + (buffer-list)))) + + +(defun bm-repository-add (data) + "Add DATA for a buffer to the repository." + ;; appending to list, makes the list sorted by time + (setq bm-repository (append bm-repository (list data))) + + ;; remove oldest element if repository is too large + (while (and bm-repository-size + (> (length bm-repository) bm-repository-size)) + (setq bm-repository (cdr bm-repository)))) + + +(defun bm-repository-remove (key) + "Remove data for a buffer from the repository identified by KEY." + (let ((repository nil)) + (if (not (assoc key bm-repository)) + ;; don't exist in repository, do nothing + nil + ;; remove all occurances + (while bm-repository + (if (not (equal key (car (car bm-repository)))) + (setq repository (append repository (list (car bm-repository))))) + (setq bm-repository (cdr bm-repository))) + (setq bm-repository repository)))) + + +(defun bm-repository-load (&optional file) + "Load the repository from the FILE specified or to `bm-repository-file'." + (if (null file) + (setq file bm-repository-file)) + (if (and file + (file-readable-p file)) + (let ((repository-buffer (find-file-noselect file))) + (setq bm-repository (with-current-buffer repository-buffer + (goto-char (point-min)) + (read (current-buffer)))) + (kill-buffer repository-buffer)))) + + +(defun bm-repository-save (&optional file) + "Save the repository to the FILE specified or to `bm-repository-file'." + (if (null file) + (setq file bm-repository-file)) + (if (and file + (file-writable-p file)) + (let ((repository-buffer (find-file-noselect file))) + (with-current-buffer repository-buffer + (erase-buffer) + (set-buffer-file-coding-system 'utf-8) + (insert ";; bm.el -- persistent bookmarks. ") + (insert "Do not edit this file.\n") + (prin1 bm-repository (current-buffer)) + (save-buffer)) + (kill-buffer repository-buffer)))) + + +(defun bm-repository-clear nil + "Clear the repository." + (interactive) + (setq bm-repository nil)) + + +(defun bm-load-and-restore nil + "Load bookmarks from persistent repository and restore them." + (interactive) + (bm-repository-load) + (bm-buffer-restore-all)) + + +(defun bm-save nil + "Save bookmarks to persistent repository." + (interactive) + (bm-buffer-save-all) + (bm-repository-save)) + + +(defun bm-buffer-file-name nil + "Get a unique key for the repository, even for non-file buffers." + (cond ((equal 'Info-mode major-mode) + (concat "[info:" Info-current-file "]")) + ((not (null (buffer-base-buffer))) + (concat "[indirect:" (buffer-name) ":" (buffer-file-name (buffer-base-buffer)) "]")) + (t (buffer-file-name)))) + + +;; restore repository on load +(if bm-restore-repository-on-load + (bm-repository-load)) + + +(provide 'bm) +;;; bm.el ends here diff --git a/elisp/emacs-goodies-el/boxquote.el b/elisp/emacs-goodies-el/boxquote.el new file mode 100755 index 0000000..9d69a6f --- /dev/null +++ b/elisp/emacs-goodies-el/boxquote.el @@ -0,0 +1,585 @@ +;;; boxquote.el --- Quote text with a semi-box. +;; Copyright 1999-2009 by Dave Pearson +;; $Revision: 1.4 $ + +;; boxquote.el is free software distributed under the terms of the GNU +;; General Public Licence, version 2 or (at your option) any later version. +;; For details see the file COPYING. + +;;; Commentary: + +;; boxquote provides a set of functions for using a text quoting style that +;; partially boxes in the left hand side of an area of text, such a marking +;; style might be used to show externally included text or example code. +;; +;; ,---- +;; | The default style looks like this. +;; `---- +;; +;; A number of functions are provided for quoting a region, a buffer, a +;; paragraph and a defun. There are also functions for quoting text while +;; pulling it in, either by inserting the contents of another file or by +;; yanking text into the current buffer. +;; +;; The latest version of boxquote.el can be found at: +;; +;; + +;;; Thanks: + +;; Kai Grossjohann for inspiring the idea of boxquote. I wrote this code to +;; mimic the "inclusion quoting" style in his Usenet posts. I could have +;; hassled him for his code but it was far more fun to write it myself. +;; +;; Mark Milhollan for providing a patch that helped me get the help quoting +;; functions working with XEmacs. +;; +;; Oliver Much for suggesting the idea of having a `boxquote-kill-ring-save' +;; function. +;; +;; Reiner Steib for suggesting `boxquote-where-is' and the idea of letting +;; `boxquote-describe-key' describe key bindings from other buffers. Also +;; thanks go to Reiner for suggesting `boxquote-insert-buffer'. + +;;; Code: + +;; Things we need: + +(eval-when-compile + (require 'cl)) +(require 'rect) + +;; Attempt to handle older/other emacs. +(eval-and-compile + + ;; If customize isn't available just use defvar instead. + (unless (fboundp 'defgroup) + (defmacro defgroup (&rest rest) nil) + (defmacro defcustom (symbol init docstring &rest rest) + `(defvar ,symbol ,init ,docstring))) + + ;; If `line-beginning-position' isn't available provide one. + (unless (fboundp 'line-beginning-position) + (defun line-beginning-position (&optional n) + "Return the `point' of the beginning of the current line." + (save-excursion + (beginning-of-line n) + (point)))) + + ;; If `line-end-position' isn't available provide one. + (unless (fboundp 'line-end-position) + (defun line-end-position (&optional n) + "Return the `point' of the end of the current line." + (save-excursion + (end-of-line n) + (point))))) + +;; Customize options. + +(defgroup boxquote nil + "Mark regions of text with a half-box." + :group 'editing + :prefix "boxquote-") + +(defcustom boxquote-top-and-tail "----" + "*Text that will be used at the top and tail of the box." + :type 'string + :group 'boxquote) + +(defcustom boxquote-top-corner "," + "*Text used for the top corner of the box." + :type 'string + :group 'boxquote) + +(defcustom boxquote-bottom-corner "`" + "*Text used for the bottom corner of the box." + :type 'string + :group 'boxquote) + +(defcustom boxquote-side "| " + "*Text used for the side of the box." + :type 'string + :group 'boxquote) + +(defcustom boxquote-title-format "[ %s ]" + "*Format string to use when creating a box title." + :type 'string + :group 'boxquote) + +(defcustom boxquote-title-files t + "*Should a `boxquote-insert-file' title the box with the file name?" + :type '(choice + (const :tag "Title the box with the file name" t) + (const :tag "Don't title the box with the file name" nil)) + :group 'boxquote) + +(defcustom boxquote-file-title-function #'file-name-nondirectory + "*Function to apply to a file's name when using it to title a box." + :type 'function + :group 'boxquote) + +(defcustom boxquote-title-buffers t + "*Should a `boxquote-insert-buffer' title the box with the buffer name?" + :type '(choice + (const :tag "Title the box with the buffer name" t) + (const :tag "Don't title the box with the buffer name" nil)) + :group 'boxquote) + +(defcustom boxquote-buffer-title-function #'identity + "*Function to apply to a buffer's name when using it to title a box." + :type 'function + :group 'boxquote) + +(defcustom boxquote-region-hook nil + "*Hooks to perform when on a region prior to boxquoting. + +Note that all forms of boxquoting use `boxquote-region' to create the +boxquote. Because of this any hook you place here will be invoked by any of +the boxquoting functions." + :type 'hook + :group 'boxquote) + +(defcustom boxquote-yank-hook nil + "*Hooks to perform on the yanked text prior to boxquoting." + :type 'hook + :group 'boxquote) + +(defcustom boxquote-insert-file-hook nil + "*Hooks to perform on the text from an inserted file prior to boxquoting." + :type 'hook + :group 'boxquote) + +(defcustom boxquote-kill-ring-save-title #'buffer-name + "*Function for working out the title for a `boxquote-kill-ring-save'. + +The string returned from this function will be used as the title for a +boxquote when the saved text is yanked into a buffer with \\[boxquote-yank]. + +An example of a non-trivial value for this variable might be: + + (lambda () + (if (string= mode-name \"Article\") + (aref gnus-current-headers 4) + (buffer-name))) + +In this case, if you are a `gnus' user, \\[boxquote-kill-ring-save] could be +used to copy text from an article buffer and, when it is yanked into another +buffer using \\[boxquote-yank], the title of the boxquote would be the ID of +the article you'd copied the text from." + :type 'function + :group 'boxquote) + +(defcustom boxquote-describe-function-title-format "C-h f %s RET" + "*Format string to use when formatting a function description box title" + :type 'string + :group 'boxquote) + +(defcustom boxquote-describe-variable-title-format "C-h v %s RET" + "*Format string to use when formatting a variable description box title" + :type 'string + :group 'boxquote) + +(defcustom boxquote-describe-key-title-format "C-h k %s" + "*Format string to use when formatting a key description box title" + :type 'string + :group 'boxquote) + +(defcustom boxquote-where-is-title-format "C-h w %s RET" + "*Format string to use when formatting a `where-is' description box title" + :type 'string + :group 'boxquote) + +(defcustom boxquote-where-is-body-format "%s is on %s" + "*Format string to use when formatting a `where-is' description." + :type 'string + :group 'boxquote) + +;; Main code: + +(defun boxquote-xemacs-p () + "Are we running in XEmacs?" + (and (boundp 'running-xemacs) (symbol-value 'running-xemacs))) + +(defun boxquote-points () + "Find the start and end points of a boxquote. + +If `point' is inside a boxquote then a cons is returned, the `car' is the +start `point' and the `cdr' is the end `point'. NIL is returned if no +boxquote is found." + (save-excursion + (beginning-of-line) + (let* ((re-top (concat "^" (regexp-quote boxquote-top-corner) + (regexp-quote boxquote-top-and-tail))) + (re-left (concat "^" (regexp-quote boxquote-side))) + (re-bottom (concat "^" (regexp-quote boxquote-bottom-corner) + (regexp-quote boxquote-top-and-tail))) + (points + (flet ((find-box-end (re &optional back) + (save-excursion + (when (if back + (search-backward-regexp re nil t) + (search-forward-regexp re nil t)) + (point))))) + (cond ((looking-at re-top) + (cons (point) (find-box-end re-bottom))) + ((looking-at re-left) + (cons (find-box-end re-top t) (find-box-end re-bottom))) + ((looking-at re-bottom) + (cons (find-box-end re-top t) (line-end-position))))))) + (when (and (car points) (cdr points)) + points)))) + +(defun boxquote-quoted-p () + "Is `point' inside a boxquote?" + (not (null (boxquote-points)))) + +(defun boxquote-points-with-check () + "Get the `boxquote-points' and flag an error of no box was found." + (or (boxquote-points) (error "I can't see a box here"))) + +(defun boxquote-title-format-as-regexp () + "Return a regular expression to match the title." + (with-temp-buffer + (insert (regexp-quote boxquote-title-format)) + (setf (point) (point-min)) + (when (search-forward "%s" nil t) + (replace-match ".*" nil t)) + (buffer-string))) + +(defun boxquote-get-title () + "Get the title for the current boxquote." + (multiple-value-bind (prefix-len suffix-len) + (with-temp-buffer + (let ((look-for "%s")) + (insert boxquote-title-format) + (setf (point) (point-min)) + (search-forward look-for) + (list (- (point) (length look-for) 1) (- (point-max) (point))))) + (save-excursion + (save-restriction + (boxquote-narrow-to-boxquote) + (setf (point) (+ (point-min) + (length (concat boxquote-top-corner + boxquote-top-and-tail)))) + (if (looking-at (boxquote-title-format-as-regexp)) + (buffer-substring-no-properties (+ (point) prefix-len) + (- (line-end-position) suffix-len)) + ""))))) + +;;;###autoload +(defun boxquote-title (title) + "Set the title of the current boxquote to TITLE. + +If TITLE is an empty string the title is removed. Note that the title will +be formatted using `boxquote-title-format'." + (interactive (list (read-from-minibuffer "Title: " (boxquote-get-title)))) + (save-excursion + (save-restriction + (boxquote-narrow-to-boxquote) + (setf (point) (+ (point-min) + (length (concat boxquote-top-corner + boxquote-top-and-tail)))) + (unless (eolp) + (kill-line)) + (unless (zerop (length title)) + (insert (format boxquote-title-format title)))))) + +;;;###autoload +(defun boxquote-region (start end) + "Draw a box around the left hand side of a region bounding START and END." + (interactive "r") + (save-excursion + (save-restriction + (flet ((bol-at-p (n) + (setf (point) n) + (bolp)) + (insert-corner (corner pre-break) + (insert (concat (if pre-break "\n" "") + corner boxquote-top-and-tail "\n")))) + (let ((break-start (not (bol-at-p start))) + (break-end (not (bol-at-p end)))) + (narrow-to-region start end) + (run-hooks 'boxquote-region-hook) + (setf (point) (point-min)) + (insert-corner boxquote-top-corner break-start) + (let ((start-point (line-beginning-position))) + (setf (point) (point-max)) + (insert-corner boxquote-bottom-corner break-end) + (string-rectangle start-point + (progn + (setf (point) (point-max)) + (forward-line -2) + (line-beginning-position)) + boxquote-side))))))) + +;;;###autoload +(defun boxquote-buffer () + "Apply `boxquote-region' to a whole buffer." + (interactive) + (boxquote-region (point-min) (point-max))) + +;;;###autoload +(defun boxquote-insert-file (filename) + "Insert the contents of a file, boxed with `boxquote-region'. + +If `boxquote-title-files' is non-nil the boxquote will be given a title that +is the result of applying `boxquote-file-title-function' to FILENAME." + (interactive "fInsert file: ") + (insert (with-temp-buffer + (insert-file-contents filename nil) + (run-hooks 'boxquote-insert-file-hook) + (boxquote-buffer) + (when boxquote-title-files + (boxquote-title (funcall boxquote-file-title-function filename))) + (buffer-string)))) + +;;;###autoload +(defun boxquote-insert-buffer (buffer) + "Insert the contents of a buffer, boxes with `boxquote-region'. + +If `boxquote-title-buffers' is non-nil the boxquote will be given a title that +is the result of applying `boxquote-buffer-title-function' to BUFFER." + (interactive "bInsert Buffer: ") + (boxquote-text + (with-current-buffer buffer + (buffer-substring-no-properties (point-min) (point-max)))) + (when boxquote-title-buffers + (boxquote-title (funcall boxquote-buffer-title-function buffer)))) + +;;;###autoload +(defun boxquote-kill-ring-save () + "Like `kill-ring-save' but remembers a title if possible. + +The title is acquired by calling `boxquote-kill-ring-save-title'. The title +will be used by `boxquote-yank'." + (interactive) + (call-interactively #'kill-ring-save) + (setf (car kill-ring-yank-pointer) + (format "%S" (list + 'boxquote-yank-marker + (funcall boxquote-kill-ring-save-title) + (car kill-ring-yank-pointer))))) + +;;;###autoload +(defun boxquote-yank () + "Do a `yank' and box it in with `boxquote-region'. + +If the yanked entry was placed on the kill ring with +`boxquote-kill-ring-save' the resulting boxquote will be titled with +whatever `boxquote-kill-ring-save-title' returned at the time." + (interactive) + (save-excursion + (insert (with-temp-buffer + (yank) + (setf (point) (point-min)) + (let ((title + (let ((yanked (condition-case nil + (read (current-buffer)) + (error nil)))) + (when (listp yanked) + (when (eq (car yanked) 'boxquote-yank-marker) + (setf (buffer-string) (nth 2 yanked)) + (nth 1 yanked)))))) + (run-hooks 'boxquote-yank-hook) + (boxquote-buffer) + (when title + (boxquote-title title)) + (buffer-string)))))) + +;;;###autoload +(defun boxquote-defun () + "Apply `boxquote-region' the current defun." + (interactive) + (mark-defun) + (boxquote-region (region-beginning) (region-end))) + +;;;###autoload +(defun boxquote-paragraph () + "Apply `boxquote-region' to the current paragraph." + (interactive) + (mark-paragraph) + (boxquote-region (region-beginning) (region-end))) + +;;;###autoload +(defun boxquote-boxquote () + "Apply `boxquote-region' to the current boxquote." + (interactive) + (let ((box (boxquote-points-with-check))) + (boxquote-region (car box) (1+ (cdr box))))) + +(defun boxquote-help-buffer-name (item) + "Return the name of the help buffer associated with ITEM." + (if (boxquote-xemacs-p) + (loop for buffer in (symbol-value 'help-buffer-list) + when (string-match (concat "^*Help:.*`" item "'") buffer) + return buffer) + "*Help*")) + +(defun boxquote-quote-help-buffer (help-call title-format item) + "Perform a help command and boxquote the output. + +HELP-CALL is a function that calls the help command. + +TITLE-FORMAT is the `format' string to use to product the boxquote title. + +ITEM is a function for retrieving the item to get help on." + (let ((one-window-p (one-window-p))) + (boxquote-text + (save-window-excursion + (funcall help-call) + (with-current-buffer (boxquote-help-buffer-name (funcall item)) + (buffer-substring-no-properties (point-min) (point-max))))) + (boxquote-title (format title-format (funcall item))) + (when one-window-p + (delete-other-windows)))) + +;;;###autoload +(defun boxquote-describe-function () + "Call `describe-function' and boxquote the output into the current buffer." + (interactive) + (boxquote-quote-help-buffer + #'(lambda () + (call-interactively #'describe-function)) + boxquote-describe-function-title-format + #'(lambda () + (car (if (boxquote-xemacs-p) + (symbol-value 'function-history) + minibuffer-history))))) + +;;;###autoload +(defun boxquote-describe-variable () + "Call `describe-variable' and boxquote the output into the current buffer." + (interactive) + (boxquote-quote-help-buffer + #'(lambda () + (call-interactively #'describe-variable)) + boxquote-describe-variable-title-format + #'(lambda () + (car (if (boxquote-xemacs-p) + (symbol-value 'variable-history) + minibuffer-history))))) + +;;;###autoload +(defun boxquote-describe-key (key) + "Call `describe-key' and boxquote the output into the current buffer. + +If the call to this command is prefixed with \\[universal-argument] you will also be +prompted for a buffer. The key defintion used will be taken from that buffer." + (interactive "kDescribe key: ") + (let ((from-buffer (if current-prefix-arg + (read-buffer "Buffer: " (current-buffer) t) + (current-buffer)))) + (let ((binding + (with-current-buffer from-buffer + (key-binding key)))) + (if (or (null binding) (integerp binding)) + (message "%s is undefined" (with-current-buffer from-buffer + (key-description key))) + (boxquote-quote-help-buffer + #'(lambda () + (with-current-buffer from-buffer + (describe-key key))) + boxquote-describe-key-title-format + #'(lambda () + (with-current-buffer from-buffer + (key-description key)))))))) + +;;;###autoload +(defun boxquote-shell-command (command) + "Call `shell-command' with COMMAND and boxquote the output." + (interactive (list (read-from-minibuffer "Shell command: " nil nil nil 'shell-command-history))) + (boxquote-text (with-temp-buffer + (shell-command command t) + (buffer-string))) + (boxquote-title command)) + +;;;###autoload +(defun boxquote-where-is (definition) + "Call `where-is' with DEFINITION and boxquote the result." + (interactive "CCommand: ") + (boxquote-text (with-temp-buffer + (where-is definition t) + (format boxquote-where-is-body-format definition (buffer-string)))) + (boxquote-title (format boxquote-where-is-title-format definition))) + +;;;###autoload +(defun boxquote-text (text) + "Insert TEXT, boxquoted." + (interactive "sText: ") + (save-excursion + (unless (bolp) + (insert "\n")) + (insert + (with-temp-buffer + (insert text) + (boxquote-buffer) + (buffer-string))))) + +;;;###autoload +(defun boxquote-narrow-to-boxquote () + "Narrow the buffer to the current boxquote." + (interactive) + (let ((box (boxquote-points-with-check))) + (narrow-to-region (car box) (cdr box)))) + +;;;###autoload +(defun boxquote-narrow-to-boxquote-content () + "Narrow the buffer to the content of the current boxquote." + (interactive) + (let ((box (boxquote-points-with-check))) + (narrow-to-region (save-excursion + (setf (point) (car box)) + (forward-line 1) + (point)) + (save-excursion + (setf (point) (cdr box)) + (line-beginning-position))))) + +;;;###autoload +(defun boxquote-kill () + "Kill the boxquote and its contents." + (interactive) + (let ((box (boxquote-points-with-check))) + (kill-region (car box) (1+ (cdr box))))) + +;;;###autoload +(defun boxquote-fill-paragraph (arg) + "Perform a `fill-paragraph' inside a boxquote." + (interactive "P") + (if (boxquote-quoted-p) + (save-restriction + (boxquote-narrow-to-boxquote-content) + (let ((fill-prefix boxquote-side)) + (fill-paragraph arg))) + (fill-paragraph arg))) + +;;;###autoload +(defun boxquote-unbox-region (start end) + "Remove a box created with `boxquote-region'." + (interactive "r") + (save-excursion + (save-restriction + (narrow-to-region start end) + (setf (point) (point-min)) + (if (looking-at (concat "^" (regexp-quote boxquote-top-corner) + (regexp-quote boxquote-top-and-tail))) + (let ((ends (concat "^[" (regexp-quote boxquote-top-corner) + (regexp-quote boxquote-bottom-corner) + "]" boxquote-top-and-tail)) + (lines (concat "^" (regexp-quote boxquote-side)))) + (loop while (< (point) (point-max)) + if (looking-at ends) do (kill-line t) + if (looking-at lines) do (delete-char 2) + do (forward-line))) + (error "I can't see a box here"))))) + +;;;###autoload +(defun boxquote-unbox () + "Remove the boxquote that contains `point'." + (interactive) + (let ((box (boxquote-points-with-check))) + (boxquote-unbox-region (car box) (1+ (cdr box))))) + +(provide 'boxquote) + +;;; boxquote.el ends here. diff --git a/elisp/emacs-goodies-el/browse-huge-tar.el b/elisp/emacs-goodies-el/browse-huge-tar.el new file mode 100755 index 0000000..f0ce385 --- /dev/null +++ b/elisp/emacs-goodies-el/browse-huge-tar.el @@ -0,0 +1,235 @@ +;;; browse-huge-tar.el --- Browse files in a tarball memory-efficiently. +;;; $Id: browse-huge-tar.el,v 1.1 2003-11-17 19:44:28 psg Exp $ +;; +;; (c) Gareth Owen 1999 (hey I just typed `space' 1999. Ho ho.) + +;; Bug reports, comments, improvements to with +;; Subject: "Stop polluting Usenet with your crappy lisp code" +;; Or not, whatever. Or just recommend your favourite records to me. + +;; Latest (yeah, right) version: http://www.geocities.com/drgazowen/lisp/ + +;; This file is not part of GNU Emacs +;; This is released under the GNU 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, 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 GNU Emacs; if not, write to the Free Software Foundation, Inc., +;; 675 Mass Ave, Cambridge, MA 02139, USA. + +;;; Commentary: +;; "It's that man Edwards! A dramatic start!" +;; (Cliff Morgan, BBC TV, Barbarians vs. New Zealand) + +;;; Different Commentary: +;; +;; This uses tar (z)tvf to browse a gzipped tar file without opening the +;; whole thing, in a dired-stylee. Knocked together in a fit of pique +;; after trying to read the xemacs source tarball in xemacs chewed through +;; all my swapspace one afternoon, and as an exercise in thesis avoidance. + +;; The trade off is memory usage vs. speed. This is very slow on large, +;; compressed tarballs, and each operation is slow individually, but +;; relatively low memory machines (like old 486s running one of the i386 +;; unices) don't handle these well with jka-compress and tar-mode either. +;; XEmacs-20.4 was a 13MB gzipped tarball and the similarly packaged linux +;; kernel 2.0.36 was 7MB, so the memory savings can be pretty high too. + +;; On small files the saving/price is pretty low, and +;; tar-mode/jka-compress have approximately 10^13 more features, so I'd +;; advise you to go that way. + +;;; BUGS: +;; i) Makes some reasonable but sometimes untrue assumptions: e.g. +;; No spaces in filenames, unless browse-huge-tar-better-heuristics is non-nil +;; files ending / in tarballs are directories. (The latter may even be true.) +;; ii) Should perform sanity-checking for directories in +;; `browse-huge-tar-copy-file-at-point' before the interactive prompt +;; (using a wrapper and call-interactively?) +;; iii) Things like default-directory that should probably get set, don't +;; get set. +;; iv) Plenty of others that are probably just hiding. +;; Bug reports to Did I say that already? + +;; TODO: Option to make the decompressed file stick around to speed up +;; repeated access at the cost of disk space. Where would the clean-up +;; go? kill-buffer-hook? + + +;;; History: +;; + +;;; Code: +(defconst browse-huge-tar-filename-valid "^ \t" + "String containing characters that mark the beginning of a filename. + +Searched for using `skip-chars-backward'") + +(defconst browse-huge-tar-filename-start-column 51 + "Column containing the start of the filename in listing produced by 'tar ztvf'.") + + +;; These magic bytes come from /usr/share/magic on my GNU/Linux box +;; Corroborated by Kai Grossjohann on comp.emacs +(defconst gzip-magic-bytes '(?\037 . ?\213) + "Dotted pair of the characters that begin a gzip file.") + +(defvar browse-huge-tar-program "tar" + "Program used for reading the index of tar archives. +Defaults to \"tar\" but may be \"gtar\" on your system. In all probability, +only those compatible with GNU tar will work") + +(defvar browse-huge-tar-file-name nil + "The filename of the tar file associated with this browse-huge-tar buffer.") +(make-variable-buffer-local 'browse-huge-tar-file-name) + +(defvar browse-huge-tar-file-zipped-p nil + "If non-nil, the tar file is gzipped.") +(make-variable-buffer-local 'browse-huge-tar-file-zipped-p) + + + +;;; Define the interactive functions +;;;###autoload +(defun browse-huge-tar-file (filename) + "Create a buffer containing a listing of FILENAME as a tar file." + (interactive "fTar file:") + ;; Set predictable values for the buffer-local variables + (setq filename (expand-file-name filename)) + (let ((buf (generate-new-buffer (concat "tar:" filename))) + (gzipped (browse-huge-tar-gzip-automagic filename))) + (set-buffer buf) + (browse-huge-tar-insert-listing filename buf gzipped) + (switch-to-buffer buf) + (browse-huge-tar-mode) + (setq browse-huge-tar-file-name filename + browse-huge-tar-file-zipped-p gzipped) + (setq buffer-read-only t) + (set-buffer-modified-p nil))) + +;; One for extracting the file through a pipe into a buffer +;;;###autoload +(defun browse-huge-tar-view-file-at-point () + "Extract the file at the point into a buffer for viewing." + (interactive) + (let ((filename (browse-huge-tar-get-filename)) buf) + (setq buf (generate-new-buffer (concat "tar:" filename))) + ;; Primitive directory detection + (if (string-match "/$" filename) + (progn ;; Clean up and abort + (kill-buffer buf) + (error (concat filename " appears to be a directory.")))) +;;; (call-process PROGRAM &optional INFILE BUFFER DISPLAYP &rest ARGS) + (call-process browse-huge-tar-program nil + buf nil (concat (if browse-huge-tar-file-zipped-p "z") "Oxf") + browse-huge-tar-file-name filename) + (switch-to-buffer buf) + (let ((buffer-file-name filename)) + (set-auto-mode)) + (setq buffer-read-only t) + (set-buffer-modified-p nil) + (goto-char (point-min)))) + +;;;###autoload +(defun browse-huge-tar-copy-file-at-point (outfile) + "Extract the file at the point and copy to a local file OUTFILE. +This requires the value of `shell-file-name' to support redirection using \">\"." + (interactive "FExtract file to: ") + (setq outfile (expand-file-name outfile)) + ;; FIX Check for directory, provide reasonable suggestion. + (let ((infile (browse-huge-tar-get-filename))) + (if (string-match "/$" infile) + (error (concat infile " appears to be a directory."))) + (if (file-directory-p outfile) + (setq outfile (concat outfile "/" infile))) + (if (or (not (file-exists-p outfile)) + (yes-or-no-p (concat outfile " exists. Overwrite? "))) + (progn + (message "Writing %s..." outfile) + (shell-command + (concat "tar" " " + (concat (if browse-huge-tar-file-zipped-p "z") "Oxf") + " " browse-huge-tar-file-name " " infile " > " outfile)))))) + + +;; Create a keymap +(defvar browse-huge-tar-mode-map nil + "Local keymap for browse-huge-tar-mode.") +(if browse-huge-tar-mode-map () + (setq browse-huge-tar-mode-map (make-keymap)) + (define-key browse-huge-tar-mode-map "\C-m" 'browse-huge-tar-view-file-at-point) + (define-key browse-huge-tar-mode-map "C" 'browse-huge-tar-copy-file-at-point) + ) + +(defvar browse-huge-tar-better-heuristics t + "This variable controls which filename extracting heuristics to use. + +If non-nil, filename fetching is based on browse-huge-tar-filename-start-column +Otherwise, it skips backwards looking for characters in +browse-huge-tar-filename-valid") + + +;; Define the utility functions +(defun browse-huge-tar-get-filename () + "In browse-huge-tar, return name of file mentioned on this line. +Value returned includes all path info associated with the file." + ;; Compute bol & eol once, + ;; (bol? Stol^H^H^H^HBorrowed code alert! from dired.el IIRC) + (let ((eol (save-excursion (skip-chars-forward "^\n\r") (point)))) + (save-excursion + (if browse-huge-tar-better-heuristics + (progn (move-to-column browse-huge-tar-filename-start-column) + (buffer-substring-no-properties (point) eol)) + (progn (goto-char eol) ;; Else + (skip-chars-backward browse-huge-tar-filename-valid) + (buffer-substring-no-properties (point) eol)))))) + +(defun browse-huge-tar-mode () + "Mode for browsing tar files without reading them into memory." + (kill-all-local-variables) + (setq major-mode 'browse-huge-tar-mode + mode-name "Browse-Huge-Tar") + (use-local-map browse-huge-tar-mode-map)) + +(defun browse-huge-tar-insert-listing (filename buf &optional gzipped) + "Insert a listing of the contents of the tar-file FILENAME. + +The contents are inserted into buffer BUF. +The optional argument GZIPPED should be non-nil if the tar file is compressed +with GNU gzip." +;;; (call-process PROGRAM &optional INFILE BUFFER DISPLAYP &rest ARGS) + (let ((errorcode (call-process browse-huge-tar-program nil buf nil + (concat (if gzipped "z") "tvf") filename))) + (if (or (not (integerp errorcode)) + (not (equal errorcode 0))) + ;; Then clean up and abort. Else, keep on keeping on + (progn (kill-buffer buf) + (error "Tar process exited abnormally with exit code %s" + errorcode))))) + +(defun browse-huge-tar-gzip-automagic (filename) + "Read the first two bytes of file FILENAME and compare with `gzip-magic-bytes'." + (let ((buf (generate-new-buffer "*browse-huge-tar-tmp*")) retval) + (save-excursion ; Necessary-p? + (set-buffer buf) + (insert-file-contents-literally filename nil 0 2) + (setq retval + (if (and (char-equal (char-after (point-min)) + (car gzip-magic-bytes)) + (char-equal (char-after (1+ (point-min))) + (cdr gzip-magic-bytes))) t nil)) + (kill-buffer buf) + (identity retval)))) ;; Is this equiv to 'C' return(retval)? + +(provide 'browse-huge-tar) + +;;; browse-huge-tar.el ends here diff --git a/elisp/emacs-goodies-el/browse-kill-ring.el b/elisp/emacs-goodies-el/browse-kill-ring.el new file mode 100755 index 0000000..f4ca6da --- /dev/null +++ b/elisp/emacs-goodies-el/browse-kill-ring.el @@ -0,0 +1,1050 @@ +;;; browse-kill-ring.el --- interactively insert items from kill-ring -*- coding: utf-8 -*- + +;; Copyright (C) 2001, 2002 Colin Walters + +;; Author: Colin Walters +;; Maintainer: Nick Hurley +;; Created: 7 Apr 2001 +;; Version: 1.3a (CVS) +;; X-RCS: $Id: browse-kill-ring.el,v 1.4 2013/12/04 22:32:10 psg Exp $ +;; URL: http://freedom.cis.ohio-state.edu/~hurley/ +;; URL-ja: http://www.fan.gr.jp/~ring/doc/browse-kill-ring.html +;; Keywords: convenience + +;; This file is not currently part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation; either version 2, or (at +;; your option) any later version. + +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program ; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; Ever feel that 'C-y M-y M-y M-y ...' is not a great way of trying +;; to find that piece of text you know you killed a while back? Then +;; browse-kill-ring.el is for you. + +;; This package is simple to install; add (require 'browse-kill-ring) +;; to your ~/.emacs file, after placing this file somewhere in your +;; `load-path'. If you want to use 'M-y' to invoke +;; `browse-kill-ring', also add (browse-kill-ring-default-keybindings) +;; to your ~/.emacs file. Alternatively, you can bind it to another +;; key such as "C-c k", with: +;; (global-set-key (kbd "C-c k") 'browse-kill-ring) + +;; Note that the command keeps track of the last window displayed to +;; handle insertion of chosen text; this might have unexpected +;; consequences if you do 'M-x browse-kill-ring', then switch your +;; window configuration, and try to use the same *Kill Ring* buffer +;; again. + +;;; Change Log: + +;; Changes from 1.3 to 1.3a: + +;; * Sneak update by Benjamin Andresen +;; * Added the read-only bugfix (http://bugs.debian.org/225082) from +;; the emacs-goodies-el package + +;; Changes from 1.2 to 1.3: + +;; * New maintainer, Nick Hurley +;; * New functions `browse-kill-ring-prepend-insert', and +;; `browse-kill-ring-append-insert', bound to 'b' and 'a' by +;; default. There are also the unbound functions +;; `browse-kill-ring-prepend-insert-and-quit', +;; `browse-kill-ring-prepend-insert-and-move', +;; `browse-kill-ring-prepend-insert-move-and-quit', +;; `browse-kill-ring-append-insert-and-quit', +;; `browse-kill-ring-append-insert-and-move', +;; `browse-kill-ring-append-insert-move-and-quit'. + +;; Changes from 1.1 to 1.2: + +;; * New variable `browse-kill-ring-resize-window', which controls +;; whether or not the browse-kill-ring window will try to resize +;; itself to fit the buffer. Implementation from Juanma Barranquero +;; . +;; * New variable `browse-kill-ring-highlight-inserted-item'. +;; Implementation from Yasutaka SHINDOH . +;; * `browse-kill-ring-mouse-insert' (normally bound to mouse-2) now +;; calls `browse-kill-ring-quit'. +;; * Some non-user-visible code cleanup. +;; * New variable `browse-kill-ring-recenter', implementation from +;; René Kyllingstad . +;; * Patch from Michal Maršuka which handles +;; read-only text better. +;; * New ability to move unkilled entries back to the beginning of the +;; ring; patch from Yasutaka SHINDOH . +;; * Do nothing if the user invokes `browse-kill-ring' when we're +;; already in a *Kill Ring* buffer (initial patch from Juanma +;; Barranquero ). + +;; Changes from 1.0 to 1.1: + +;; * Important keybinding change! The default bindings of RET and 'i' +;; have switched; this means typing RET now by default inserts the +;; text and calls `browse-kill-ring-quit'; 'i' just inserts. +;; * The variable `browse-kill-ring-use-fontification' is gone; +;; browse-kill-ring.el has been rewritten to use font-lock. XEmacs +;; users who want fontification will have to do: +;; (add-hook 'browse-kill-ring-hook 'font-lock-mode) +;; * Integrated code from Michael Slass into +;; `browse-kill-ring-default-keybindings'. +;; * New Japanese homepage for browse-kill-ring.el, thanks to +;; Yasutaka SHINDOH . +;; * Correctly restore window configuration after editing an entry. +;; * New command `browse-kill-ring-insert-and-delete'. +;; * Bug reports and patches from Michael Slass and +;; Juanma Barranquero . + +;; Changes from 0.9b to 1.0: + +;; * Add autoload cookie to `browse-kill-ring'; suggestion from +;; D. Goel and Dave Pearson . +;; * Add keybinding tip from Michael Slass . + +;; Changes from 0.9a to 0.9b: + +;; * Remove extra parenthesis. Duh. + +;; Changes from 0.9 to 0.9a: + +;; * Fix bug making `browse-kill-ring-quit-action' uncustomizable. +;; Patch from Henrik Enberg . +;; * Add `url-link' and `group' attributes to main Customization +;; group. + +;; Changes from 0.8 to 0.9: + +;; * Add new function `browse-kill-ring-insert-and-quit', bound to 'i' +;; by default (idea from Yasutaka Shindoh). +;; * Make default `browse-kill-ring-quit-action' be +;; `bury-and-delete-window', which handles the case of a single window +;; more nicely. +;; * Note change of home page and author address. + +;; Changes from 0.7 to 0.8: + +;; * Fix silly bug in `browse-kill-ring-edit' which made it impossible +;; to edit entries. +;; * New variable `browse-kill-ring-quit-action'. +;; * `browse-kill-ring-restore' renamed to `browse-kill-ring-quit'. +;; * Describe the keymaps in mode documentation. Patch from +;; Marko Slyz . +;; * Fix advice documentation for `browse-kill-ring-no-duplicates'. + +;; Changes from 0.6 to 0.7: + +;; * New functions `browse-kill-ring-search-forward' and +;; `browse-kill-ring-search-backward', bound to "s" and "r" by +;; default, respectively. +;; * New function `browse-kill-ring-edit' bound to "e" by default, and +;; a associated new major mode. +;; * New function `browse-kill-ring-occur', bound to "l" by default. + +;; Changes from 0.5 to 0.6: + +;; * Fix bug in `browse-kill-ring-forward' which sometimes would cause +;; a message "Wrong type argument: overlayp, nil" to appear. +;; * New function `browse-kill-ring-update'. +;; * New variable `browse-kill-ring-highlight-current-entry'. +;; * New variable `browse-kill-ring-display-duplicates'. +;; * New optional advice `browse-kill-ring-no-kill-new-duplicates', +;; and associated variable `browse-kill-ring-no-duplicates'. Code +;; from Klaus Berndl . +;; * Bind "?" to `describe-mode'. Patch from Dave Pearson +;; . +;; * Fix typo in `browse-kill-ring-display-style' defcustom form. +;; Thanks "Kahlil (Kal) HODGSON" . + +;; Changes from 0.4 to 0.5: + +;; * New function `browse-kill-ring-delete', bound to "d" by default. +;; * New function `browse-kill-ring-undo', bound to "U" by default. +;; * New variable `browse-kill-ring-maximum-display-length'. +;; * New variable `browse-kill-ring-use-fontification'. +;; * New variable `browse-kill-ring-hook', called after the +;; "*Kill Ring*" buffer is created. + +;; Changes from 0.3 to 0.4: + +;; * New functions `browse-kill-ring-forward' and +;; `browse-kill-ring-previous', bound to "n" and "p" by default, +;; respectively. +;; * Change the default `browse-kill-ring-display-style' to +;; `separated'. +;; * Removed `browse-kill-ring-original-window-config'; Now +;; `browse-kill-ring-restore' just buries the "*Kill Ring*" buffer +;; and deletes its window, which is simpler and more intuitive. +;; * New variable `browse-kill-ring-separator-face'. + +;;; Bugs: + +;; * Sometimes, in Emacs 21, the cursor will jump to the end of an +;; entry when moving backwards using `browse-kill-ring-previous'. +;; This doesn't seem to occur in Emacs 20 or XEmacs. + +;;; Code: + +(eval-when-compile + (require 'cl) + (require 'derived)) + +(when (featurep 'xemacs) + (require 'overlay)) + +(defun browse-kill-ring-depropertize-string (str) + "Return a copy of STR with text properties removed." + (let ((str (copy-sequence str))) + (set-text-properties 0 (length str) nil str) + str)) + +(cond ((fboundp 'propertize) + (defalias 'browse-kill-ring-propertize 'propertize)) + ;; Maybe save some memory :) + ((fboundp 'ibuffer-propertize) + (defalias 'browse-kill-ring-propertize 'ibuffer-propertize)) + (t + (defun browse-kill-ring-propertize (string &rest properties) + "Return a copy of STRING with text properties added. + + [Note: this docstring has been copied from the Emacs 21 version] + +First argument is the string to copy. +Remaining arguments form a sequence of PROPERTY VALUE pairs for text +properties to add to the result." + (let ((str (copy-sequence string))) + (add-text-properties 0 (length str) + properties + str) + str)))) + +(defgroup browse-kill-ring nil + "A package for browsing and inserting the items in `kill-ring'." + :link '(url-link "http://freedom.cis.ohio-state.edu/~hurley/") + :group 'convenience) + +(defvar browse-kill-ring-display-styles + '((separated . browse-kill-ring-insert-as-separated) + (one-line . browse-kill-ring-insert-as-one-line))) + +(defcustom browse-kill-ring-display-style 'separated + "How to display the kill ring items. + +If `one-line', then replace newlines with \"\\n\" for display. + +If `separated', then display `browse-kill-ring-separator' between +entries." + :type '(choice (const :tag "One line" one-line) + (const :tag "Separated" separated)) + :group 'browse-kill-ring) + +(defcustom browse-kill-ring-quit-action 'bury-and-delete-window + "What action to take when `browse-kill-ring-quit' is called. + +If `bury-buffer', then simply bury the *Kill Ring* buffer, but keep +the window. + +If `bury-and-delete-window', then bury the buffer, and (if there is +more than one window) delete the window. This is the default. + +If `save-and-restore', then save the window configuration when +`browse-kill-ring' is called, and restore it at quit. + +If `kill-and-delete-window', then kill the *Kill Ring* buffer, and +delete the window on close. + +Otherwise, it should be a function to call." + :type '(choice (const :tag "Bury buffer" :value bury-buffer) + (const :tag "Delete window" :value delete-window) + (const :tag "Save and restore" :value save-and-restore) + (const :tag "Bury buffer and delete window" :value bury-and-delete-window) + (const :tag "Kill buffer and delete window" :value kill-and-delete-window) + function) + :group 'browse-kill-ring) + +(defcustom browse-kill-ring-resize-window nil + "Whether to resize the `browse-kill-ring' window to fit its contents. +Value is either t, meaning yes, or a cons pair of integers, + (MAXIMUM . MINIMUM) for the size of the window. MAXIMUM defaults to +the window size chosen by `pop-to-buffer'; MINIMUM defaults to +`window-min-height'." + :type '(choice (const :tag "No" nil) + (const :tag "Yes" t) + (cons (integer :tag "Maximum") (integer :tag "Minimum"))) + :group 'browse-kill-ring) + +(defcustom browse-kill-ring-separator "-------" + "The string separating entries in the `separated' style. +See `browse-kill-ring-display-style'." + :type 'string + :group 'browse-kill-ring) + +(defcustom browse-kill-ring-recenter nil + "If non-nil, then always keep the current entry at the top of the window." + :type 'boolean + :group 'browse-kill-ring) + +(defcustom browse-kill-ring-highlight-current-entry nil + "If non-nil, highlight the currently selected `kill-ring' entry." + :type 'boolean + :group 'browse-kill-ring) + +(defcustom browse-kill-ring-highlight-inserted-item browse-kill-ring-highlight-current-entry + "If non-nil, temporarily highlight the inserted `kill-ring' entry." + :type 'boolean + :group 'browse-kill-ring) + +(defcustom browse-kill-ring-separator-face 'bold + "The face in which to highlight the `browse-kill-ring-separator'." + :type 'face + :group 'browse-kill-ring) + +(defcustom browse-kill-ring-maximum-display-length nil + "Whether or not to limit the length of displayed items. + +If this variable is an integer, the display of `kill-ring' will be +limited to that many characters. +Setting this variable to nil means no limit." + :type '(choice (const :tag "None" nil) + integer) + :group 'browse-kill-ring) + +(defcustom browse-kill-ring-display-duplicates t + "If non-nil, then display duplicate items in `kill-ring'." + :type 'boolean + :group 'browse-kill-ring) + +(defadvice kill-new (around browse-kill-ring-no-kill-new-duplicates) + "An advice for not adding duplicate elements to `kill-ring'. +Even after being \"activated\", this advice will only modify the +behavior of `kill-new' when `browse-kill-ring-no-duplicates' +is non-nil." + (if browse-kill-ring-no-duplicates + (setq kill-ring (delete (ad-get-arg 0) kill-ring))) + ad-do-it) + +(defcustom browse-kill-ring-no-duplicates nil + "If non-nil, then the `b-k-r-no-kill-new-duplicates' advice will operate. +This means that duplicate entries won't be added to the `kill-ring' +when you call `kill-new'. + +If you set this variable via customize, the advice will be activated +or deactivated automatically. Otherwise, to enable the advice, add + + (ad-enable-advice 'kill-new 'around 'browse-kill-ring-no-kill-new-duplicates) + (ad-activate 'kill-new) + +to your init file." + :type 'boolean + :set (lambda (symbol value) + (set symbol value) + (if value + (ad-enable-advice 'kill-new 'around + 'browse-kill-ring-no-kill-new-duplicates) + (ad-disable-advice 'kill-new 'around + 'browse-kill-ring-no-kill-new-duplicates)) + (ad-activate 'kill-new)) + :group 'browse-kill-ring) + +(defcustom browse-kill-ring-depropertize nil + "If non-nil, remove text properties from `kill-ring' items. +This only changes the items for display and insertion from +`browse-kill-ring'; if you call `yank' directly, the items will be +inserted with properties." + :type 'boolean + :group 'browse-kill-ring) + +(defcustom browse-kill-ring-hook nil + "A list of functions to call after `browse-kill-ring'." + :type 'hook + :group 'browse-kill-ring) + +(defvar browse-kill-ring-original-window-config nil + "The window configuration to restore for `browse-kill-ring-quit'.") +(make-variable-buffer-local 'browse-kill-ring-original-window-config) + +(defvar browse-kill-ring-original-window nil + "The window in which chosen kill ring data will be inserted. +It is probably not a good idea to set this variable directly; simply +call `browse-kill-ring' again.") + +(defun browse-kill-ring-mouse-insert (e) + "Insert the chosen text, and close the *Kill Ring* buffer afterwards." + (interactive "e") + (let* ((data (save-excursion + (mouse-set-point e) + (cons (current-buffer) (point)))) + (buf (car data)) + (pt (cdr data))) + (browse-kill-ring-do-insert buf pt)) + (browse-kill-ring-quit)) + +(if (fboundp 'fit-window-to-buffer) + (defalias 'browse-kill-ring-fit-window 'fit-window-to-buffer) + (defun browse-kill-ring-fit-window (window max-height min-height) + (setq min-height (or min-height window-min-height)) + (setq max-height (or max-height (- (frame-height) (window-height) 1))) + (let* ((window-min-height min-height) + (windows (count-windows)) + (config (current-window-configuration))) + (enlarge-window (- max-height (window-height))) + (when (> windows (count-windows)) + (set-window-configuration config)) + (if (/= (point-min) (point-max)) + (shrink-window-if-larger-than-buffer window) + (shrink-window (- (window-height) window-min-height)))))) + +(defun browse-kill-ring-resize-window () + (when browse-kill-ring-resize-window + (apply #'browse-kill-ring-fit-window (selected-window) + (if (consp browse-kill-ring-resize-window) + (list (car browse-kill-ring-resize-window) + (or (cdr browse-kill-ring-resize-window) + window-min-height)) + (list nil window-min-height))))) + +(defun browse-kill-ring-undo-other-window () + "Undo the most recent change in the other window's buffer. +You most likely want to use this command for undoing an insertion of +yanked text from the *Kill Ring* buffer." + (interactive) + (with-current-buffer (window-buffer browse-kill-ring-original-window) + (undo))) + +(defun browse-kill-ring-insert (&optional quit) + "Insert the kill ring item at point into the last selected buffer. +If optional argument QUIT is non-nil, close the *Kill Ring* buffer as +well." + (interactive "P") + (browse-kill-ring-do-insert (current-buffer) + (point)) + (when quit + (browse-kill-ring-quit))) + +(defun browse-kill-ring-insert-and-delete (&optional quit) + "Insert the kill ring item at point, and remove it from the kill ring. +If optional argument QUIT is non-nil, close the *Kill Ring* buffer as +well." + (interactive "P") + (browse-kill-ring-do-insert (current-buffer) + (point)) + (browse-kill-ring-delete) + (when quit + (browse-kill-ring-quit))) + +(defun browse-kill-ring-insert-and-quit () + "Like `browse-kill-ring-insert', but close the *Kill Ring* buffer afterwards." + (interactive) + (browse-kill-ring-insert t)) + +(defun browse-kill-ring-insert-and-move (&optional quit) + "Like `browse-kill-ring-insert', but move the entry to the front." + (interactive "P") + (let ((buf (current-buffer)) + (pt (point))) + (browse-kill-ring-do-insert buf pt) + (let ((str (browse-kill-ring-current-string buf pt))) + (browse-kill-ring-delete) + (kill-new str))) + (if quit + (browse-kill-ring-quit) + (browse-kill-ring-update))) + +(defun browse-kill-ring-insert-move-and-quit () + "Like `browse-kill-ring-insert-and-move', but close the *Kill Ring* buffer." + (interactive) + (browse-kill-ring-insert-and-move t)) + +(defun browse-kill-ring-prepend-insert (&optional quit) + "Like `browse-kill-ring-insert', but it places the entry at the beginning +of the buffer as opposed to point." + (interactive "P") + (browse-kill-ring-do-prepend-insert (current-buffer) + (point)) + (when quit + (browse-kill-ring-quit))) + +(defun browse-kill-ring-prepend-insert-and-quit () + "Like `browse-kill-ring-prepend-insert', but close the *Kill Ring* buffer." + (interactive) + (browse-kill-ring-prepend-insert t)) + +(defun browse-kill-ring-prepend-insert-and-move (&optional quit) + "Like `browse-kill-ring-prepend-insert', but move the entry to the front +of the *Kill Ring*." + (interactive "P") + (let ((buf (current-buffer)) + (pt (point))) + (browse-kill-ring-do-prepend-insert buf pt) + (let ((str (browse-kill-ring-current-string buf pt))) + (browse-kill-ring-delete) + (kill-new str))) + (if quit + (browse-kill-ring-quit) + (browse-kill-ring-update))) + +(defun browse-kill-ring-prepend-insert-move-and-quit () + "Like `browse-kill-ring-prepend-insert-and-move', but close the +*Kill Ring* buffer." + (interactive) + (browse-kill-ring-prepend-insert-and-move t)) + +(defun browse-kill-ring-do-prepend-insert (buf pt) + (let ((str (browse-kill-ring-current-string buf pt))) + (let ((orig (current-buffer))) + (unwind-protect + (progn + (unless (window-live-p browse-kill-ring-original-window) + (error "Window %s has been deleted; Try calling `browse-kill-ring' again" + browse-kill-ring-original-window)) + (set-buffer (window-buffer browse-kill-ring-original-window)) + (save-excursion + (let ((pt (point))) + (goto-char (point-min)) + (insert (if browse-kill-ring-depropertize + (browse-kill-ring-depropertize-string str) + str)) + (when browse-kill-ring-highlight-inserted-item + (let ((o (make-overlay (point-min) (point)))) + (overlay-put o 'face 'highlight) + (sit-for 0.5) + (delete-overlay o))) + (goto-char pt)))) + (set-buffer orig))))) + +(defun browse-kill-ring-append-insert (&optional quit) + "Like `browse-kill-ring-insert', but places the entry at the end of the +buffer as opposed to point." + (interactive "P") + (browse-kill-ring-do-append-insert (current-buffer) + (point)) + (when quit + (browse-kill-ring-quit))) + +(defun browse-kill-ring-append-insert-and-quit () + "Like `browse-kill-ring-append-insert', but close the *Kill Ring* buffer." + (interactive) + (browse-kill-ring-append-insert t)) + +(defun browse-kill-ring-append-insert-and-move (&optional quit) + "Like `browse-kill-ring-append-insert', but move the entry to the front +of the *Kill Ring*." + (interactive "P") + (let ((buf (current-buffer)) + (pt (point))) + (browse-kill-ring-do-append-insert buf pt) + (let ((str (browse-kill-ring-current-string buf pt))) + (browse-kill-ring-delete) + (kill-new str))) + (if quit + (browse-kill-ring-quit) + (browse-kill-ring-update))) + +(defun browse-kill-ring-append-insert-move-and-quit () + "Like `browse-kill-ring-append-insert-and-move', but close the +*Kill Ring* buffer." + (interactive) + (browse-kill-ring-append-insert-and-move t)) + +(defun browse-kill-ring-do-append-insert (buf pt) + (let ((str (browse-kill-ring-current-string buf pt))) + (let ((orig (current-buffer))) + (unwind-protect + (progn + (unless (window-live-p browse-kill-ring-original-window) + (error "Window %s has been deleted; Try calling `browse-kill-ring' again" + browse-kill-ring-original-window)) + (set-buffer (window-buffer browse-kill-ring-original-window)) + (save-excursion + (let ((pt (point)) + (begin-pt (point-max))) + (goto-char begin-pt) + (insert (if browse-kill-ring-depropertize + (browse-kill-ring-depropertize-string str) + str)) + (when browse-kill-ring-highlight-inserted-item + (let ((o (make-overlay begin-pt (point-max)))) + (overlay-put o 'face 'highlight) + (sit-for 0.5) + (delete-overlay o))) + (goto-char pt)))) + (set-buffer orig))))) + +(defun browse-kill-ring-delete () + "Remove the item at point from the `kill-ring'." + (interactive) + (let ((over (car (overlays-at (point))))) + (unless (overlayp over) + (error "No kill ring item here")) + (unwind-protect + (progn + (setq buffer-read-only nil) + (let ((target (overlay-get over 'browse-kill-ring-target))) + (delete-region (overlay-start over) + (1+ (overlay-end over))) + (setq kill-ring (delete target kill-ring))) + (when (get-text-property (point) 'browse-kill-ring-extra) + (let ((prev (previous-single-property-change (point) + 'browse-kill-ring-extra)) + (next (next-single-property-change (point) + 'browse-kill-ring-extra))) + ;; This is some voodoo. + (when prev + (incf prev)) + (when next + (incf next)) + (delete-region (or prev (point-min)) + (or next (point-max)))))) + (setq buffer-read-only t))) + (browse-kill-ring-resize-window) + (browse-kill-ring-forward 0)) + +(defun browse-kill-ring-current-string (buf pt) + (with-current-buffer buf + (let ((overs (overlays-at pt))) + (or (and overs + (overlay-get (car overs) 'browse-kill-ring-target)) + (error "No kill ring item here"))))) + +(defun browse-kill-ring-do-insert (buf pt) + (let ((str (browse-kill-ring-current-string buf pt))) + (let ((orig (current-buffer))) + (unwind-protect + (progn + (unless (window-live-p browse-kill-ring-original-window) + (error "Window %s has been deleted; Try calling `browse-kill-ring' again" + browse-kill-ring-original-window)) + (set-buffer (window-buffer browse-kill-ring-original-window)) + (save-excursion + (let ((pt (point))) + (insert (if browse-kill-ring-depropertize + (browse-kill-ring-depropertize-string str) + str)) + (when browse-kill-ring-highlight-inserted-item + (let ((o (make-overlay pt (point)))) + (overlay-put o 'face 'highlight) + (sit-for 0.5) + (delete-overlay o)))))) + (set-buffer orig))))) + +(defun browse-kill-ring-forward (&optional arg) + "Move forward by ARG `kill-ring' entries." + (interactive "p") + (beginning-of-line) + (while (not (zerop arg)) + (if (< arg 0) + (progn + (incf arg) + (if (overlays-at (point)) + (progn + (goto-char (overlay-start (car (overlays-at (point))))) + (goto-char (previous-overlay-change (point))) + (goto-char (previous-overlay-change (point)))) + (progn + (goto-char (1- (previous-overlay-change (point)))) + (unless (bobp) + (goto-char (overlay-start (car (overlays-at (point))))))))) + (progn + (decf arg) + (if (overlays-at (point)) + (progn + (goto-char (overlay-end (car (overlays-at (point))))) + (goto-char (next-overlay-change (point)))) + (goto-char (next-overlay-change (point))) + (unless (eobp) + (goto-char (overlay-start (car (overlays-at (point)))))))))) + ;; This could probably be implemented in a more intelligent manner. + ;; Perhaps keep track over the overlay we started from? That would + ;; break when the user moved manually, though. + (when (and browse-kill-ring-highlight-current-entry + (overlays-at (point))) + (let ((overs (overlay-lists)) + (current-overlay (car (overlays-at (point))))) + (mapcar #'(lambda (o) + (overlay-put o 'face nil)) + (nconc (car overs) (cdr overs))) + (overlay-put current-overlay 'face 'highlight))) + (when browse-kill-ring-recenter + (recenter 1))) + +(defun browse-kill-ring-previous (&optional arg) + "Move backward by ARG `kill-ring' entries." + (interactive "p") + (browse-kill-ring-forward (- arg))) + +(defun browse-kill-ring-read-regexp (msg) + (let* ((default (car regexp-history)) + (input + (read-from-minibuffer + (if default + (format "%s for regexp (default `%s'): " + msg + default) + (format "%s (regexp): " msg)) + nil + nil + nil + 'regexp-history))) + (if (equal input "") + default + input))) + +(defun browse-kill-ring-search-forward (regexp &optional backwards) + "Move to the next `kill-ring' entry matching REGEXP from point. +If optional arg BACKWARDS is non-nil, move to the previous matching +entry." + (interactive + (list (browse-kill-ring-read-regexp "Search forward") + current-prefix-arg)) + (let ((orig (point))) + (browse-kill-ring-forward (if backwards -1 1)) + (let ((overs (overlays-at (point)))) + (while (and overs + (not (if backwards (bobp) (eobp))) + (not (string-match regexp + (overlay-get (car overs) + 'browse-kill-ring-target)))) + (browse-kill-ring-forward (if backwards -1 1)) + (setq overs (overlays-at (point)))) + (unless (and overs + (string-match regexp + (overlay-get (car overs) + 'browse-kill-ring-target))) + (progn + (goto-char orig) + (message "No more `kill-ring' entries matching %s" regexp)))))) + +(defun browse-kill-ring-search-backward (regexp) + "Move to the previous `kill-ring' entry matching REGEXP from point." + (interactive + (list (browse-kill-ring-read-regexp "Search backward"))) + (browse-kill-ring-search-forward regexp t)) + +(defun browse-kill-ring-quit () + "Take the action specified by `browse-kill-ring-quit-action'." + (interactive) + (case browse-kill-ring-quit-action + (save-and-restore + (let (buf (current-buffer)) + (set-window-configuration browse-kill-ring-original-window-config) + (kill-buffer buf))) + (kill-and-delete-window + (kill-buffer (current-buffer)) + (unless (= (count-windows) 1) + (delete-window))) + (bury-and-delete-window + (bury-buffer) + (unless (= (count-windows) 1) + (delete-window))) + (t + (funcall browse-kill-ring-quit-action)))) + +(put 'browse-kill-ring-mode 'mode-class 'special) +(define-derived-mode browse-kill-ring-mode fundamental-mode + "Kill Ring" + "A major mode for browsing the `kill-ring'. +You most likely do not want to call `browse-kill-ring-mode' directly; use +`browse-kill-ring' instead. + +\\{browse-kill-ring-mode-map}" + (set (make-local-variable 'font-lock-defaults) + '(nil t nil nil nil + (font-lock-fontify-region-function . browse-kill-ring-fontify-region))) + (define-key browse-kill-ring-mode-map (kbd "q") 'browse-kill-ring-quit) + (define-key browse-kill-ring-mode-map (kbd "U") 'browse-kill-ring-undo-other-window) + (define-key browse-kill-ring-mode-map (kbd "d") 'browse-kill-ring-delete) + (define-key browse-kill-ring-mode-map (kbd "s") 'browse-kill-ring-search-forward) + (define-key browse-kill-ring-mode-map (kbd "r") 'browse-kill-ring-search-backward) + (define-key browse-kill-ring-mode-map (kbd "g") 'browse-kill-ring-update) + (define-key browse-kill-ring-mode-map (kbd "l") 'browse-kill-ring-occur) + (define-key browse-kill-ring-mode-map (kbd "e") 'browse-kill-ring-edit) + (define-key browse-kill-ring-mode-map (kbd "n") 'browse-kill-ring-forward) + (define-key browse-kill-ring-mode-map (kbd "p") 'browse-kill-ring-previous) + (define-key browse-kill-ring-mode-map [(mouse-2)] 'browse-kill-ring-mouse-insert) + (define-key browse-kill-ring-mode-map (kbd "?") 'describe-mode) + (define-key browse-kill-ring-mode-map (kbd "h") 'describe-mode) + (define-key browse-kill-ring-mode-map (kbd "y") 'browse-kill-ring-insert) + (define-key browse-kill-ring-mode-map (kbd "u") 'browse-kill-ring-insert-move-and-quit) + (define-key browse-kill-ring-mode-map (kbd "i") 'browse-kill-ring-insert) + (define-key browse-kill-ring-mode-map (kbd "o") 'browse-kill-ring-insert-and-move) + (define-key browse-kill-ring-mode-map (kbd "x") 'browse-kill-ring-insert-and-delete) + (define-key browse-kill-ring-mode-map (kbd "RET") 'browse-kill-ring-insert-and-quit) + (define-key browse-kill-ring-mode-map (kbd "b") 'browse-kill-ring-prepend-insert) + (define-key browse-kill-ring-mode-map (kbd "a") 'browse-kill-ring-append-insert)) + +;;;###autoload +(defun browse-kill-ring-default-keybindings () + "Set up M-y (`yank-pop') so that it can invoke `browse-kill-ring'. +Normally, if M-y was not preceeded by C-y, then it has no useful +behavior. This function sets things up so that M-y will invoke +`browse-kill-ring'." + (interactive) + (defadvice yank-pop (around kill-ring-browse-maybe (arg)) + "If last action was not a yank, run `browse-kill-ring' instead." + ;; yank-pop has an (interactive "*p") form which does not allow + ;; it to run in a read-only buffer. We want browse-kill-ring to + ;; be allowed to run in a read only buffer, so we change the + ;; interactive form here. In that case, we need to + ;; barf-if-buffer-read-only if we're going to call yank-pop with + ;; ad-do-it + (interactive "p") + (if (not (eq last-command 'yank)) + (browse-kill-ring) + (barf-if-buffer-read-only) + ad-do-it)) + (ad-activate 'yank-pop)) + +(define-derived-mode browse-kill-ring-edit-mode fundamental-mode + "Kill Ring Edit" + "A major mode for editing a `kill-ring' entry. +You most likely do not want to call `browse-kill-ring-edit-mode' +directly; use `browse-kill-ring' instead. + +\\{browse-kill-ring-edit-mode-map}" + (define-key browse-kill-ring-edit-mode-map (kbd "C-c C-c") + 'browse-kill-ring-edit-finish)) + +(defvar browse-kill-ring-edit-target nil) +(make-variable-buffer-local 'browse-kill-ring-edit-target) + +(defun browse-kill-ring-edit () + "Edit the `kill-ring' entry at point." + (interactive) + (let ((overs (overlays-at (point)))) + (unless overs + (error "No kill ring entry here")) + (let* ((target (overlay-get (car overs) + 'browse-kill-ring-target)) + (target-cell (member target kill-ring))) + (unless target-cell + (error "Item deleted from the kill-ring")) + (switch-to-buffer (get-buffer-create "*Kill Ring Edit*")) + (setq buffer-read-only nil) + (erase-buffer) + (insert target) + (goto-char (point-min)) + (browse-kill-ring-resize-window) + (browse-kill-ring-edit-mode) + (message "%s" + (substitute-command-keys + "Use \\[browse-kill-ring-edit-finish] to finish editing.")) + (setq browse-kill-ring-edit-target target-cell)))) + +(defun browse-kill-ring-edit-finish () + "Commit the changes to the `kill-ring'." + (interactive) + (if browse-kill-ring-edit-target + (setcar browse-kill-ring-edit-target (buffer-string)) + (when (y-or-n-p "The item has been deleted; add to front? ") + (push (buffer-string) kill-ring))) + (bury-buffer) + ;; The user might have rearranged the windows + (when (eq major-mode 'browse-kill-ring-mode) + (browse-kill-ring-setup (current-buffer) + browse-kill-ring-original-window + nil + browse-kill-ring-original-window-config) + (browse-kill-ring-resize-window))) + +(defmacro browse-kill-ring-add-overlays-for (item &rest body) + (let ((beg (gensym "browse-kill-ring-add-overlays-")) + (end (gensym "browse-kill-ring-add-overlays-"))) + `(let ((,beg (point)) + (,end + (progn + ,@body + (point)))) + (let ((o (make-overlay ,beg ,end))) + (overlay-put o 'browse-kill-ring-target ,item) + (overlay-put o 'mouse-face 'highlight))))) +;; (put 'browse-kill-ring-add-overlays-for 'lisp-indent-function 1) + +(defun browse-kill-ring-elide (str) + (if (and browse-kill-ring-maximum-display-length + (> (length str) + browse-kill-ring-maximum-display-length)) + (concat (substring str 0 (- browse-kill-ring-maximum-display-length 3)) + (browse-kill-ring-propertize "..." 'browse-kill-ring-extra t)) + str)) + +(defun browse-kill-ring-insert-as-one-line (items) + (dolist (item items) + (browse-kill-ring-add-overlays-for item + (let* ((item (browse-kill-ring-elide item)) + (len (length item)) + (start 0) + (newl (browse-kill-ring-propertize "\\n" 'browse-kill-ring-extra t))) + (while (and (< start len) + (string-match "\n" item start)) + (insert (substring item start (match-beginning 0)) + newl) + (setq start (match-end 0))) + (insert (substring item start len)))) + (insert "\n"))) + +(defun browse-kill-ring-insert-as-separated (items) + (while (cdr items) + (browse-kill-ring-insert-as-separated-1 (car items) t) + (setq items (cdr items))) + (when items + (browse-kill-ring-insert-as-separated-1 (car items) nil))) + +(defun browse-kill-ring-insert-as-separated-1 (origitem separatep) + (let* ((item (browse-kill-ring-elide origitem)) + (len (length item))) + (browse-kill-ring-add-overlays-for origitem + (insert item)) + ;; When the kill-ring has items with read-only text property at + ;; **the end of** string, browse-kill-ring-setup fails with error + ;; `Text is read-only'. So inhibit-read-only here. + ;; See http://bugs.debian.org/225082 + ;; - INOUE Hiroyuki + (let ((inhibit-read-only t)) + (insert "\n") + (when separatep + (insert (browse-kill-ring-propertize browse-kill-ring-separator + 'browse-kill-ring-extra t + 'browse-kill-ring-separator t)) + (insert "\n"))))) + +(defun browse-kill-ring-occur (regexp) + "Display all `kill-ring' entries matching REGEXP." + (interactive + (list + (browse-kill-ring-read-regexp "Display kill ring entries matching"))) + (assert (eq major-mode 'browse-kill-ring-mode)) + (browse-kill-ring-setup (current-buffer) + browse-kill-ring-original-window + regexp) + (browse-kill-ring-resize-window)) + +(defun browse-kill-ring-fontify-on-property (prop face beg end) + (save-excursion + (goto-char beg) + (let ((prop-end nil)) + (while + (setq prop-end + (let ((prop-beg (or (and (get-text-property (point) prop) (point)) + (next-single-property-change (point) prop nil end)))) + (when (and prop-beg (not (= prop-beg end))) + (let ((prop-end (next-single-property-change prop-beg prop nil end))) + (when (and prop-end (not (= prop-end end))) + (put-text-property prop-beg prop-end 'face face) + prop-end))))) + (goto-char prop-end))))) + +(defun browse-kill-ring-fontify-region (beg end &optional verbose) + (when verbose (message "Fontifying...")) + (let ((buffer-read-only nil)) + (browse-kill-ring-fontify-on-property 'browse-kill-ring-extra 'bold beg end) + (browse-kill-ring-fontify-on-property 'browse-kill-ring-separator + browse-kill-ring-separator-face beg end)) + (when verbose (message "Fontifying...done"))) + +(defun browse-kill-ring-update () + "Update the buffer to reflect outside changes to `kill-ring'." + (interactive) + (assert (eq major-mode 'browse-kill-ring-mode)) + (browse-kill-ring-setup (current-buffer) + browse-kill-ring-original-window) + (browse-kill-ring-resize-window)) + +(defun browse-kill-ring-setup (buf window &optional regexp window-config) + (with-current-buffer buf + (unwind-protect + (progn + (browse-kill-ring-mode) + (setq buffer-read-only nil) + (when (eq browse-kill-ring-display-style + 'one-line) + (setq truncate-lines t)) + (let ((inhibit-read-only t)) + (erase-buffer)) + (setq browse-kill-ring-original-window window + browse-kill-ring-original-window-config + (or window-config + (current-window-configuration))) + (let ((browse-kill-ring-maximum-display-length + (if (and browse-kill-ring-maximum-display-length + (<= browse-kill-ring-maximum-display-length 3)) + 4 + browse-kill-ring-maximum-display-length)) + (items (mapcar + (if browse-kill-ring-depropertize + #'browse-kill-ring-depropertize-string + #'copy-sequence) + kill-ring))) + (when (not browse-kill-ring-display-duplicates) + ;; I'm not going to rewrite `delete-duplicates'. If + ;; someone really wants to rewrite it here, send me a + ;; patch. + (require 'cl) + (setq items (delete-duplicates items :test #'equal))) + (when (stringp regexp) + (setq items (delq nil + (mapcar + #'(lambda (item) + (when (string-match regexp item) + item)) + items)))) + (funcall (or (cdr (assq browse-kill-ring-display-style + browse-kill-ring-display-styles)) + (error "Invalid `browse-kill-ring-display-style': %s" + browse-kill-ring-display-style)) + items) +;; Code from Michael Slass + (message + (let ((entry (if (= 1 (length kill-ring)) "entry" "entries"))) + (concat + (if (and (not regexp) + browse-kill-ring-display-duplicates) + (format "%s %s in the kill ring." + (length kill-ring) entry) + (format "%s (of %s) %s in the kill ring shown." + (length items) (length kill-ring) entry)) + (substitute-command-keys + (concat " Type \\[browse-kill-ring-quit] to quit. " + "\\[describe-mode] for help."))))) +;; End code from Michael Slass + (set-buffer-modified-p nil) + (goto-char (point-min)) + (browse-kill-ring-forward 0) + (when regexp + (setq mode-name (concat "Kill Ring [" regexp "]"))) + (run-hooks 'browse-kill-ring-hook) + ;; I will be very glad when I can get rid of this gross + ;; hack, which solely exists for XEmacs users. + (when (and (featurep 'xemacs) + font-lock-mode) + (browse-kill-ring-fontify-region (point-min) (point-max))))) + (progn + (setq buffer-read-only t))))) + +;;;###autoload +(defun browse-kill-ring () + "Display items in the `kill-ring' in another buffer." + (interactive) + (if (eq major-mode 'browse-kill-ring-mode) + (message "Already viewing the kill ring") + (let ((orig-buf (current-buffer)) + (buf (get-buffer-create "*Kill Ring*"))) + (browse-kill-ring-setup buf (selected-window)) + (pop-to-buffer buf) + (browse-kill-ring-resize-window) + nil))) + +(provide 'browse-kill-ring) + +;;; browse-kill-ring.el ends here diff --git a/elisp/emacs-goodies-el/button-lock.el b/elisp/emacs-goodies-el/button-lock.el new file mode 100644 index 0000000..e6a8dd6 --- /dev/null +++ b/elisp/emacs-goodies-el/button-lock.el @@ -0,0 +1,1076 @@ +;;; button-lock.el --- Clickable text defined by regular expression +;; +;; Copyright (c) 2011-14 Roland Walker +;; +;; Author: Roland Walker +;; Homepage: http://github.com/rolandwalker/button-lock +;; URL: http://raw.githubusercontent.com/rolandwalker/button-lock/master/button-lock.el +;; Version: 1.0.0 +;; Last-Updated: 21 Oct 2013 +;; EmacsWiki: ButtonLockMode +;; Keywords: mouse, button, hypermedia, extensions +;; +;; Simplified BSD License +;; +;;; Commentary: +;; +;; Quickstart +;; +;; (require 'button-lock) +;; +;; (global-button-lock-mode 1) +;; +;; (setq url-button (button-lock-set-button +;; "\\ +;; +;; buttons.el +;; Miles Bader +;; +;; Notes +;; +;; By default, button-lock uses newfangled left-clicks rather than +;; Emacs-traditional middle clicks. +;; +;; Font lock is very efficient, but it is still possible to bog +;; things down if you feed it expensive regular expressions. Use +;; anchored expressions, and be careful about backtracking. See +;; `regexp-opt'. +;; +;; Some differences between button-lock.el and hi-lock.el: +;; +;; * The purpose of hi-lock.el is to change the _appearance_ +;; of keywords. The purpose of button-lock is to change the +;; _bindings_ on keywords. +;; +;; * Hi-lock also supports embedding new keywords in files, +;; which is too risky of an approach for button-lock. +;; +;; * Hi-lock supports overlays and can work without font-lock. +;; +;; Some differences between button-lock.el and buttons.el +;; +;; * Buttons.el is for inserting individually defined +;; buttons. Button-lock.el is for changing all matching text +;; into a button. +;; +;; Compatibility and Requirements +;; +;; GNU Emacs version 24.4-devel : yes, at the time of writing +;; GNU Emacs version 24.3 : yes +;; GNU Emacs version 23.3 : yes +;; GNU Emacs version 22.2 : yes, with some limitations +;; GNU Emacs version 21.x and lower : unknown +;; +;; No external dependencies +;; +;; Bugs +;; +;; Case-sensitivity of matches depends on how font-lock-defaults +;; was called for the current mode (setting +;; font-lock-keywords-case-fold-search). So, it is safest to +;; assume that button-lock pattern matches are case-sensitive -- +;; though they might not be. +;; +;; Return value for button-lock-register-global-button is inconsistent +;; with button-lock-set-button. The global function does not +;; return a button which could be later passed to +;; button-lock-extend-binding, nor are the arguments parsed and +;; checked for validity. Any errors for global buttons are also +;; deferred until the mode is activated. +;; +;; TODO +;; +;; Validate arguments to button-lock-register-global-button. +;; maybe split set-button into create/set functions, where +;; the create function does all validation and returns a +;; button object. Pass in button object to unset as well. +;; +;; Why are mouse and keyboard separate, can't mouse be passed +;; through kbd macro? The issue may have been just surrounding +;; mouse events with "<>" before passing to kbd. +;; +;; Look into new syntax-propertize-function variable (Emacs 24.x). +;; +;; A refresh function to toggle every buffer? +;; +;; Peek into font-lock-keywords and deduplicate based on the +;; stored patterns. +;; +;; Substitute a function for regexp to make properties invisible +;; unless button-lock mode is on - esp for keymaps. +;; +;; Add predicate argument to button-set where predicate is +;; evaluated during matcher. This could be used to test for +;; comment-only. +;; +;; Consider defining mode-wide button locks (pass the mode as the +;; first argument of font-lock-add-keywords). Could use functions +;; named eg button-lock-set-modal-button. +;; +;; Add a language-specific navigation library (header files in C, +;; etc). +;; +;; Example of exchanging text values on wheel event. +;; +;; Convenience parameters for right-click menus. +;; +;; Button-down visual effects as with Emacs widgets. +;; +;; License +;; +;; Simplified BSD License +;; +;; Copyright (c) 2011-12, Roland Walker +;; All rights reserved. +;; +;; Redistribution and use in source and binary forms, with or +;; without modification, are permitted provided that the following +;; conditions are met: +;; +;; 1. Redistributions of source code must retain the above +;; copyright notice, this list of conditions and the following +;; disclaimer. +;; +;; 2. Redistributions in binary form must reproduce the above +;; copyright notice, this list of conditions and the following +;; disclaimer in the documentation and/or other materials +;; provided with the distribution. +;; +;; Ths software is provided by Roland Walker "AS IS" and any express +;; or implied warranties, including, but not limited to, the implied +;; warranties of merchantability and fitness for a particular +;; purpose are disclaimed. In no event shall Roland Walker or +;; contributors be liable for any direct, indirect, incidental, +;; special, exemplary, or consequential damages (including, but not +;; limited to, procurement of substitute goods or services; loss of +;; use, data, or profits; or business interruption) however caused +;; and on any theory of liability, whether in contract, strict +;; liability, or tort (including negligence or otherwise) arising in +;; any way out of the use of this software, even if advised of the +;; possibility of such damage. +;; +;; The views and conclusions contained in the software and +;; documentation are those of the authors and should not be +;; interpreted as representing official policies, either expressed +;; or implied, of Roland Walker. +;; +;;; Change Log: +;; +;; 22 Aug 2012 +;; Rewrite. Incompatible changes: +;; +;; * `button-lock-pop-button' removed, replaced with the ability to +;; pass a button "object" to `button-lock-unset-button'. +;; +;; * `button-lock-unset-all-buttons' replaced by +;; `button-lock-clear-all-buttons'. +;; +;; * `button-lock-set-global-button' and `button-lock-unset-global-button' +;; replaced by `button-lock-register-global-button' and +;; `button-lock-unregister-global-button'. +;; +;; * `button-lock-unset-all-global-buttons' replaced by +;; `button-lock-unregister-all-global-buttons'. +;; +;; * `button-lock-pop-global-button' removed. +;; +;; * lighter variable name and content changed. +;; +;;; Code: +;; + +;;; requirements + +;; for callf, callf2, defun*, union +(require 'cl) + +(require 'font-lock) + +;;; customizable variables + +;;;###autoload +(defgroup button-lock nil + "Clickable text defined by regular expression." + :version "1.0.0" + :link '(emacs-commentary-link :tag "Commentary" "button-lock") + :link '(url-link :tag "GitHub" "http://github.com/rolandwalker/button-lock") + :link '(url-link :tag "EmacsWiki" "http://emacswiki.org/emacs/ButtonLockMode") + :prefix "button-lock-" + :group 'navigation + :group 'mouse + :group 'extensions) + +(defcustom button-lock-exclude-modes '( + fundamental-mode + Buffer-menu-mode + bm-show-mode + dired-mode + eshell-mode + gnus-article-mode + mime/viewer-mode + rmail-mode + term-mode + ) + "Modes for which global button-lock will not be activated. + +Modes may be excluded for reasons of security (since buttons can +execute arbitrary functions), efficiency, or to avoid conflicts +with modes that provide similar functionality." + :type '(repeat symbol) + :group 'button-lock) + +(defcustom button-lock-buffer-name-exclude-pattern "\\`[* ]" + "Do not activate minor made in buffers matching this regular expression. + +Buffers may be excluded for reasons of security (since buttons +can execute arbitrary functions), efficiency, or to avoid +conflicts with modes that provide similar functionality. + +The default pattern is designed to match buffers which are +programatically generated or internal to Emacs." + :type 'regexp + :group 'button-lock) + +(defcustom button-lock-buffer-include-functions '() + "Do not activate minor mode in a buffer unless all functions evaluate non-nil. + +Each function should take a single argument (a buffer). + +Set this value to nil to disable." + :type '(repeat function) + :group 'button-lock) + +(defcustom button-lock-buffer-exclude-functions '() + "Do not activate minor mode in a buffer if any function evaluates non-nil. + +Each function should take a single argument (a buffer). + +Set this value to nil to disable." + :type '(repeat function) + :group 'button-lock) + +(defcustom button-lock-mode-lighter " b-loc" + "This string appears in the mode-line when `button-lock-mode' is active. + +Set to nil or the empty string to disable the mode-line +lighter for `button-lock-mode'." + :type 'string + :group 'button-lock) +(put 'button-lock-mode-lighter 'risky-local-variable t) + +;;; faces + +(defface button-lock-button-face + '((t nil)) + "Face used to show active button-lock buttons. + +The default is for buttons to inherit whatever properties are +already provided by font-lock." + :group 'button-lock) + +(defface button-lock-mouse-face + '((t (:inherit highlight))) + "Face used to highlight button-lock buttons when the mouse hovers over." + :group 'button-lock) + +;;; variables + +(defvar button-lock-global-button-list nil + "Global button definitions added to every button-lock buffer. + +The form is a list of lists, each member being a set of arguments +to `button-lock-set-button'. + +This variable should be set by calling +`button-lock-register-global-button' and friends.") + +(defvar button-lock-button-list nil + "An internal variable used to keep track of button-lock buttons.") + +(defvar button-lock-mode nil + "Mode variable for `button-lock-mode'.") + +(make-variable-buffer-local 'button-lock-mode) +(make-variable-buffer-local 'button-lock-button-list) +(put 'button-lock-button-list 'permanent-local t) + +;;; macros + +(defmacro button-lock-called-interactively-p (&optional kind) + "A backward-compatible version of `called-interactively-p'. + +Optional KIND is as documented at `called-interactively-p' +in GNU Emacs 24.1 or higher." + (cond + ((not (fboundp 'called-interactively-p)) + '(interactive-p)) + ((condition-case nil + (progn (called-interactively-p 'any) t) + (error nil)) + `(called-interactively-p ,kind)) + (t + '(called-interactively-p)))) + +;;; compatibility functions + +;; string-match-p is new in 23.x and above +(unless (fboundp 'string-match-p) + (defsubst string-match-p (regexp string &optional start) + "Same as `string-match' except this function does not change the match data." + (let ((inhibit-changing-match-data t)) + (string-match regexp string start)))) + +;;; utility functions + +;; buffer functions + +(defun button-lock-buffer-included-p (buf) + "Return BUF if global button-lock should enable button-lock in BUF." + (when (and (not noninteractive) + (bufferp buf) + (buffer-name buf)) + (with-current-buffer buf + (when (and (not (minibufferp buf)) + (not (eq (aref (buffer-name) 0) ?\s)) ; overlaps with exclude-pattern + (not (memq major-mode button-lock-exclude-modes)) + (not (string-match-p button-lock-buffer-name-exclude-pattern (buffer-name buf))) + (catch 'success + (dolist (filt button-lock-buffer-exclude-functions) + (when (funcall filt buf) + (throw 'success nil))) + t) + (catch 'failure + (dolist (filt button-lock-buffer-include-functions) + (unless (funcall filt buf) + (throw 'failure nil))) + t)) + buf)))) + +(defun button-lock-maybe-unbuttonify-buffer () + "This is a workaround for cperl mode, which clobbers `font-lock-unfontify-region-function'." + (when (and (boundp 'font-lock-fontified) + font-lock-fontified + (not (eq font-lock-unfontify-region-function 'font-lock-default-unfontify-region))) + (font-lock-default-unfontify-region (point-min) (point-max)))) + +(defun button-lock-maybe-fontify-buffer () + "Fontify, but only if font-lock is already on. + +This is to avoid turning on font-lock if we are in the process of +disabling button-lock." + (when (and (boundp 'font-lock-fontified) + font-lock-fontified) + (font-lock-fontify-buffer))) + +;; button functions + +;;;###autoload +(defun button-lock-button-properties (button) + "Return list of properties for BUTTON." + (when (listp button) + (cadr (cadr (cadr button))))) + +;;;###autoload +(defun button-lock-button-p (button) + "Return t if BUTTON is a button-lock button." + (ignore-errors + (car (memq 'button-lock (button-lock-button-properties button))))) + +;;;###autoload +(defun button-lock-button-pattern (button) + "Return pattern for BUTTON." + (when (listp button) + (car button))) + +;;;###autoload +(defun button-lock-button-grouping (button) + "Return grouping for BUTTON." + (when (listp button) + (car (cadr button)))) + +;;;###autoload +(defun button-lock-find-extent (&optional pos property) + "Find the extent of a button-lock property around some point. + +POS defaults to the current point. PROPERTY defaults to +'button-lock. + +Returns a cons in the form (START . END), or nil if there +is no such PROPERTY around POS." + (callf or pos (point)) + (callf or property 'button-lock) + (when (get-text-property pos property) + (cons (if (and (> pos (point-min)) (get-text-property (1- pos) property)) (previous-single-property-change pos property) pos) + (next-single-property-change pos property)))) + +;; font-lock functions + +(defun button-lock-tell-font-lock (&optional forget) + "Tell `font-lock-keywords' about the buttons in `button-lock-button-list'. + +When FORGET is set, tell `font-lock-keywords' to forget about +the buttons in `button-lock-button-list', as well as any other +keywords with the 'button-lock property." + (if forget + (let ((keywords (copy-tree font-lock-keywords))) + (when (eq t (car keywords)) + ;; get uncompiled keywords + (setq keywords (cadr keywords))) + (dolist (kw (union keywords button-lock-button-list)) + (when (button-lock-button-p kw) + (font-lock-remove-keywords nil (list kw))))) + (unless button-lock-mode + (error "Button-lock mode is not in effect")) + (dolist (button button-lock-button-list) + (font-lock-remove-keywords nil (list button)) + (font-lock-add-keywords nil (list button))))) + +(defun button-lock-do-tell () + "Run `button-lock-tell-font-lock' appropriately in hooks." + (when button-lock-mode + (if font-lock-mode + (button-lock-tell-font-lock) + (button-lock-tell-font-lock 'forget)))) + +;; internal driver for local buttons + +(defun button-lock-remove-from-button-list (button) + "Remove BUTTON from `button-lock-button-list' and `font-lock-keywords'." + (when button-lock-mode + (font-lock-remove-keywords nil (list button)) + (button-lock-maybe-unbuttonify-buffer) ; cperl-mode workaround + (button-lock-maybe-fontify-buffer)) + (callf2 delete button button-lock-button-list) + nil) + +(defun button-lock-add-to-button-list (button &optional no-replace) + "Add BUTTON to `button-lock-button-list' and `font-lock-keywords'. + +The regexp used by the button is checked against the existing +data structure. If the regexp duplicates that of an existing button, +the existing duplicate is replaced. + +If NO-REPLACE is set, no replacement is made for a duplicate button." + (let ((conflict (catch 'hit + (dolist (b button-lock-button-list) + (when (equal (car b) (car button)) + (throw 'hit b)))))) + (if (and conflict no-replace) + conflict + (when (and conflict (not no-replace)) + (button-lock-remove-from-button-list conflict)) + (add-to-list 'button-lock-button-list button) + (when button-lock-mode + (font-lock-add-keywords nil (list button)) + (button-lock-maybe-fontify-buffer)) + button))) + +;; internal driver for global buttons + +(defun button-lock-remove-from-global-button-list (button) + "Remove BUTTON from `button-lock-global-button-list'." + (callf2 delete button button-lock-global-button-list)) + +(defun button-lock-add-to-global-button-list (button &optional no-replace) + "Add BUTTON to `button-lock-global-button-list'. + +The regexp used by the button is checked against the existing +data structure. If the regexp duplicates that of an existing button, +the existing duplicate is replaced. + +If NO-REPLACE is set, no replacement is made for a duplicate button." + (let ((conflict (catch 'hit + (dolist (b button-lock-global-button-list) + (when (equal (car b) (car button)) + (throw 'hit b)))))) + (unless (and conflict no-replace) + (when (and conflict (not no-replace)) + (button-lock-remove-from-global-button-list conflict)) + (add-to-list 'button-lock-global-button-list button)))) + +(defun button-lock-merge-global-buttons-to-local () + "Add predefined, non-conflicting global buttons to the local list." + (dolist (button button-lock-global-button-list) + (unless (member button button-lock-button-list) + (apply 'button-lock-set-button (append button '(:no-replace t)))))) + +;;; minor-mode definition + +;;;###autoload +(define-minor-mode button-lock-mode + "Toggle button-lock-mode, a minor mode for making text clickable. + +Button-lock uses `font-lock-mode' to create and maintain its text +properties. Therefore this mode can only be used where +`font-lock-mode' is active. + +`button-lock-set-button' may be called to create a new button. +`button-lock-clear-all-buttons' may be called to clear all button +definitions in a buffer. + +When called interactively with no prefix argument, this command +toggles the mode. When called interactively, with a prefix +argument, it enables the mode if the argument is positive and +otherwise disables it. When called from Lisp, it enables the +mode if the argument is omitted or nil, and toggles the mode if +the argument is 'toggle." + nil button-lock-mode-lighter nil + (cond + ((and button-lock-mode + (or noninteractive ; never turn on button-lock where + (eq (aref (buffer-name) 0) ?\s))) ; there can be no font-lock + (setq button-lock-mode nil)) + (button-lock-mode + (font-lock-mode 1) + (button-lock-merge-global-buttons-to-local) + (add-hook 'font-lock-mode-hook 'button-lock-do-tell nil t) + (button-lock-tell-font-lock) + (button-lock-maybe-fontify-buffer) + (when (button-lock-called-interactively-p 'interactive) + (message "button-lock mode enabled"))) + (t + (button-lock-tell-font-lock 'forget) + (button-lock-maybe-unbuttonify-buffer) ; cperl-mode workaround + (button-lock-maybe-fontify-buffer) + (when (button-lock-called-interactively-p 'interactive) + (message "button-lock mode disabled"))))) + +;;; global minor-mode definition + +(defun button-lock-maybe-turn-on (&optional arg) + "Activate `button-lock-mode' in a buffer if appropriate. + +button-lock mode will be activated in every buffer, except + + minibuffers + buffers with names that begin with space + buffers excluded by `button-lock-exclude-modes' + buffers excluded by `button-lock-buffer-name-exclude-pattern' + +If called with a negative ARG, deactivate button-lock mode in the +buffer." + (callf or arg 1) + (when (or (< arg 0) + (button-lock-buffer-included-p (current-buffer))) + (button-lock-mode arg))) + +;;;###autoload +(define-globalized-minor-mode global-button-lock-mode button-lock-mode button-lock-maybe-turn-on + :group 'button-lock) + +;;; principal external interface + +;;;###autoload +(defun* button-lock-set-button (pattern action &key + + (face 'button-lock-face) + (mouse-face 'button-lock-mouse-face) + (face-policy 'append) + help-echo + help-text + kbd-help + kbd-help-multiline + + (grouping 0) + + (mouse-binding 'mouse-1) + keyboard-binding + keyboard-action + additional-property + rear-sticky + + remove + no-replace + + mouse-2 + mouse-3 + mouse-4 + mouse-5 + wheel-down + wheel-up + + down-mouse-1 + down-mouse-2 + down-mouse-3 + down-mouse-4 + down-mouse-5 + + double-mouse-1 + double-mouse-2 + double-mouse-3 + double-mouse-4 + double-mouse-5 + + triple-mouse-1 + triple-mouse-2 + triple-mouse-3 + triple-mouse-4 + triple-mouse-5 + + A-mouse-1 + A-mouse-2 + A-mouse-3 + A-mouse-4 + A-mouse-5 + A-wheel-down + A-wheel-up + + C-mouse-1 + C-mouse-2 + C-mouse-3 + C-mouse-4 + C-mouse-5 + C-wheel-down + C-wheel-up + + M-mouse-1 + M-mouse-2 + M-mouse-3 + M-mouse-4 + M-mouse-5 + M-wheel-down + M-wheel-up + + S-mouse-1 + S-mouse-2 + S-mouse-3 + S-mouse-4 + S-mouse-5 + S-wheel-down + S-wheel-up + + s-mouse-1 + s-mouse-2 + s-mouse-3 + s-mouse-4 + s-mouse-5 + s-wheel-down + s-wheel-up) + +"Attach mouse actions to text via `font-lock-mode'. + +Required argument PATTERN is a regular expression to match. + +Required argument ACTION is a function to call when the matching +text is clicked. A quoted function name or a lambda expression +may be given. The function called by ACTION must be interactive. +If ACTION is not valid the user may experience a silent failure. + +If the function called by ACTION uses (interactive \"e\") it may +receive the relevant mouse event. Note that you may wish to use +the mouse event to reposition the point. + +ACTION may alternatively contain a prepared keymap, in which case +the convenience parameters :MOUSE-BINDING, :KEYBOARD-BINDING, +and :KEYBOARD-ACTION will be ignored. + +Following PATTERN and ACTION is a Common Lisp-style series of +keyword/value arguments: + +Setting :NO-REPLACE causes the function to have no effect when +a button already exists using the given PATTERN. By default, +any existing button using PATTERN will be replaced. + +:FACE is a font face to set on matching text, like hi-lock mode. +By default, :FACE has no properties, and :FACE-POLICY is :APPEND. +This means that other, existing text properties will take +priority, and that clickable text will not be distinguished +without a mouseover. To change this, try adding the arguments +\":face 'link :face-policy 'prepend.\" Alternatively, +`button-lock-face' may be customized. + +:MOUSE-FACE is the font face to set on mouseovers. It defaults +to `button-lock-mouse-face'. + +:FACE-POLICY sets the override policy for button faces. Useful +values are nil, 'keep, 'prepend, and 'append (the default). See +the documentation for OVERRIDE in `font-lock-keywords'. + +:HELP-ECHO is applied to the 'help-echo text property, and may +become visible in a tooltip depending on your Emacs setup. +:HELP-TEXT is a deprecated synonym. + +:KBD-HELP is applied to the 'kbd-help text property, accessible +to the user via `display-local-help', + +:KBD-HELP-MULTILINE is applied to the non-standard +'kbd-help-multiline text property. + +:GROUPING designates a subgroup in the pattern match to receive +the new text properties. Subgroups, delimited by parentheses, +are numbered from 1. The default :GROUPING is 0, indicating the +entire match. + +:MOUSE-BINDING sets the mouse event which will invoke ACTION. +The default is 'mouse-1. + +:KEYBOARD-BINDING sets a keyboard event which will invoke ACTION. +The format is as accepted by `kbd'. The default is nil, meaning +no keyboard binding is in effect. If this is set, it might also +be wise to alert the user by setting :FACE. Note, the only +difference between :MOUSE-BINDING and :KEYBOARD-BINDING is +that :KEYBOARD-BINDING is interpreted by `kbd'. It is possible +to pass keyboard events into :MOUSE-BINDING and vice versa. + +:KEYBOARD-ACTION is an alternate event to be run by +:KEYBOARD-BINDING. The default is nil, meaning that +:KEYBOARD-BINDING will invoke ACTION. This is intended for cases +where ACTION is dependent on the position of the mouse. + +:ADDITIONAL-PROPERTY defines an arbitrary text property which +will be set to t in for text which matches PATTERN, as optionally +modified by :GROUPING. The property 'button-lock will always be +set. + +As a convenience, :MOUSE-2 through :MOUSE-5 can be used to attach +an alternate ACTION, as can :M-MOUSE-1 ..., :A-MOUSE-1 ..., +:DOUBLE-MOUSE-1 ..., :WHEEL-UP..., and :WHEEL-DOWN... The list is not +exhaustive. For a general method of adding alternate bindings, pass +a keymap for :ACTION or use `button-lock-extend-binding'. + +If :REAR-STICKY is non-nil, the rear-nonsticky text property will +not be added, as it is by default. Changing this setting is not +recommended. + +If :REMOVE is non-nil, any existing button using PATTERN will +be removed and forgotten by font-lock. + +If successful, this function returns the button which was added +or removed from `font-lock-keywords'. Otherwise it returns nil. +The button value can be passed to `button-lock-extend-binding'." + + (let ((map (make-sparse-keymap)) + (properties nil) + (fl-keyword nil)) + + (if (keymapp action) + (setq map (copy-sequence action)) + + ;; else + (define-key map `[,mouse-binding] action) + + (dolist (var '( + mouse-2 + mouse-3 + mouse-4 + mouse-5 + wheel-down + wheel-up + + down-mouse-1 + down-mouse-2 + down-mouse-3 + down-mouse-4 + down-mouse-5 + + double-mouse-1 + double-mouse-2 + double-mouse-3 + double-mouse-4 + double-mouse-5 + + triple-mouse-1 + triple-mouse-2 + triple-mouse-3 + triple-mouse-4 + triple-mouse-5 + + A-mouse-1 + A-mouse-2 + A-mouse-3 + A-mouse-4 + A-mouse-5 + A-wheel-down + A-wheel-up + + C-mouse-1 + C-mouse-2 + C-mouse-3 + C-mouse-4 + C-mouse-5 + C-wheel-down + C-wheel-up + + M-mouse-1 + M-mouse-2 + M-mouse-3 + M-mouse-4 + M-mouse-5 + M-wheel-down + M-wheel-up + + S-mouse-1 + S-mouse-2 + S-mouse-3 + S-mouse-4 + S-mouse-5 + S-wheel-down + S-wheel-up + + s-mouse-1 + s-mouse-2 + s-mouse-3 + s-mouse-4 + s-mouse-5 + s-wheel-down + s-wheel-up)) + + (when (symbol-value var) + (define-key map `[,var] (symbol-value var)))) + + (when keyboard-binding + (define-key map (read-kbd-macro keyboard-binding) (or keyboard-action action)))) + + (setq properties `(face ,face keymap ,map button-lock t)) + (add-to-list 'font-lock-extra-managed-props 'keymap) + (add-to-list 'font-lock-extra-managed-props 'button-lock) + + (when additional-property + (callf append properties `(,additional-property t)) + (add-to-list 'font-lock-extra-managed-props additional-property)) + + (when mouse-face + (callf append properties `(mouse-face ,mouse-face)) + (add-to-list 'font-lock-extra-managed-props 'mouse-face)) + + (when (or help-echo help-text) + (callf append properties `(help-echo ,(or help-echo help-text))) + (add-to-list 'font-lock-extra-managed-props 'help-echo)) + + (when kbd-help + (callf append properties `(kbd-help ,kbd-help)) + (add-to-list 'font-lock-extra-managed-props 'kbd-help)) + + (when kbd-help-multiline + (callf append properties `(kbd-help-multiline ,kbd-help-multiline)) + (add-to-list 'font-lock-extra-managed-props 'kbd-help-multiline)) + + (unless rear-sticky + (callf append properties `(rear-nonsticky t)) + (add-to-list 'font-lock-extra-managed-props 'rear-nonsticky)) + + (setq fl-keyword `(,pattern (,grouping ',properties ,face-policy))) + + (if remove + (button-lock-remove-from-button-list fl-keyword) + (button-lock-add-to-button-list fl-keyword no-replace)))) + +;;;###autoload +(defun button-lock-unset-button (&rest button) + "Equivalent to running `button-lock-set-button' with :REMOVE set to true. + +The syntax is otherwise identical to `button-lock-set-button', +which see. + +A single argument BUTTON object may also be passed, which was returned +from `button-lock-set-button'." + (if (and (= 1 (length button)) + (button-lock-button-p (car button))) + (button-lock-remove-from-button-list (car button)) + (apply 'button-lock-set-button (append button '(:remove t))))) + +;;;###autoload +(defun button-lock-extend-binding (existing-button action mouse-binding &optional keyboard-binding) + "Add a binding to an existing button. + +The principal button creation function `button-lock-set-button' +accepts only a limited subset of mouse bindings when binding +multiple actions. This function supports arbitrary key bindings +for binding additional actions on a button. + +EXISTING-BUTTON is a button value as returned by +`button-lock-set-button'. + +ACTION, MOUSE-BINDING and KEYBOARD-BINDING are as documented in +`button-lock-set-button'. It is possible to pass a nil +MOUSE-BINDING in order to set only a KEYBOARD-BINDING. + +When passing a prepared keymap for ACTION, set MOUSE-BINDING +to nil." + (when (not (member existing-button button-lock-button-list)) + (error "No such button")) + (let ((map (cadr (memq 'keymap (button-lock-button-properties (car (member existing-button button-lock-button-list))))))) + (when button-lock-mode + (font-lock-remove-keywords nil (list existing-button))) + (if (keymapp action) + (dolist (cell (cdr action)) + (define-key map (vector (car cell)) (cdr cell))) + ;; else + (when mouse-binding + (define-key map `[,mouse-binding] action)) + (when keyboard-binding + (define-key map (read-kbd-macro keyboard-binding) action))) + (when button-lock-mode + (font-lock-add-keywords nil (list existing-button))))) + +;;;###autoload +(defun button-lock-clear-all-buttons () + "Remove and deactivate all button-lock buttons in the buffer. + +If FORCE is non-nil, try to remove buttons even when the minor +mode is not active." + (interactive) + (let ((num (length button-lock-button-list))) + (button-lock-tell-font-lock 'forget) + (setq button-lock-button-list nil) + (button-lock-maybe-unbuttonify-buffer) ; cperl-mode workaround + (button-lock-maybe-fontify-buffer) + (when (and + (button-lock-called-interactively-p 'interactive) + (> num 0)) + (message "removed %d button patterns" num)) + num)) + +;;;###autoload +(defun button-lock-register-global-button (&rest button) + "Register a global button-lock button definition. + +Arguments follow the form of `button-lock-set-button'. + +The BUTTON defined here will applied each time the button-lock +minor mode is activated in a buffer. + +To see an effect in any given buffer, button-lock mode must be +deactivated and reactivated." + (button-lock-add-to-global-button-list button)) + +;;;###autoload +(defun button-lock-unregister-global-button (&rest button) + "Remove global button-lock BUTTON. + +Arguments follow the form of `button-lock-set-button'. + +To see an effect in any given buffer, button-lock mode must be +deactivated and reactivated." + (button-lock-remove-from-global-button-list button)) + +;;;###autoload +(defun button-lock-unregister-all-global-buttons () + "Remove all global button-lock buttons definitions. + +To see an effect in any given buffer, button-lock mode must be +deactivated and reactivated." + (interactive) + (setq button-lock-global-button-list nil) + t) + +(provide 'button-lock) + +;; +;; Emacs +;; +;; Local Variables: +;; indent-tabs-mode: nil +;; mangle-whitespace: t +;; require-final-newline: t +;; coding: utf-8 +;; byte-compile-warnings: (not cl-functions redefine) +;; End: +;; +;; LocalWords: ButtonLockMode mouseable mybutton keymap propertize +;; LocalWords: callf cperl nonsticky setq fixmee devel uncompiled +;; LocalWords: MULTILINE multiline Koppelman Bader +;; + +;;; button-lock.el ends here diff --git a/elisp/emacs-goodies-el/clipper.el b/elisp/emacs-goodies-el/clipper.el new file mode 100755 index 0000000..ace60b8 --- /dev/null +++ b/elisp/emacs-goodies-el/clipper.el @@ -0,0 +1,355 @@ +;;; clipper.el --- save strings of data for further use. + +;; Copyright (C) 1997-2000 Free Software Foundation, Inc. + +;; Author: Kevin A. Burton (burton@openprivacy.org) +;; Maintainer: Kevin A. Burton (burton@openprivacy.org) +;; Location: http://relativity.yi.org +;; Keywords: clip save text +;; Version: 1.1.1 + +;; This file is [not yet] part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify it under +;; the terms of the GNU General Public License as published by the Free Software +;; Foundation; either version 2 of the License, or any later version. +;; +;; This program is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +;; FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +;; details. +;; +;; You should have received a copy of the GNU General Public License along with +;; this program; if not, write to the Free Software Foundation, Inc., 59 Temple +;; Place - Suite 330, Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; Clipper is a way to handle 'clips' of text with some persistance via handles. +;; A good example is something like the GNU Public License. If you do a lot of +;; Free Software work and need to have a copy of the GPL for insertion in your +;; source files, you can save this text as a 'GPL' clip. When you call +;; clipper-insert you will be prompted for a name and when you enter GPL this +;; will be inserted. +;; +;; Clipper can also perform search and replacement on token names. For example +;; if want the current buffer filename you can use the token +;; CLIPPER_FILE_NAME_NONDIRECTORY. +;; +;; Available tokens are: +;; +;; CLIPPER_FILE_NAME_NONDIRECTORY +;; +;; The current filename without it's directory. If this buffer isn't +;; backed on disk then the buffer name is used. +;; +;; CLIPPER_FILE_NAME_NONDIRECTORY_SANS_EXTENSION +;; +;; The current filename without it's directory and without an extension. + +;;; Usage: +;; +;; install via (require 'clipper) in your .emacs file. +;; +;; The following functions allow you to manipulate clipper: +;; +;; `clipper-create' create a new clip +;; +;; `clipper-delete' delete an existing clip +;; +;; `clipper-insert' insert a clip into the current buffer +;; +;; `clipper-edit-clip' edit an existing clip. +;; +;; You might also want to setup personal key bindings: +;; +;; (global-set-key "\C-cci" 'clipper-insert) +;; (global-set-key "\C-ccc" 'clipper-create) + + +;;; TODO + +;; sort the alist with `sort' + +;;; History: +;; +;; - Wed Jan 30 2002 03:14 PM (burton@openprivacy.org): fixed a bug WRT data +;; loss when editing existing clips. +;; +;; - Sun Nov 04 2001 05:33 PM (burton@openprivacy.org): we are now supporting a +;; file-name-nondirectory in special buffers. +;; +;; - Sun Nov 04 2001 05:31 PM (burton@openprivacy.org): clipper-save was not +;; smart enough. We now save-excursion, use find-file-noselect and localize +;; find-file-hooks so that saves are cleaner and faster. +;; +;; - Sat Mar 17 00:02:18 2001 (burton@relativity.yi.org): migrate to load-file +;; instead of manually evaluating the file +;; +;; - Tue Jan 2 03:51:45 2001 (burton): Version 1.0.1. Added support for editing +;; clips thanks to a prototype function provided by Joe Humrickhouse +;; which was modularized with the current creation +;; function. Added fontlock for the input buffer. + +;; +;;; Code: + +(require 'font-lock) + +(defvar clipper-alist '() "Associated list for holding clips.") + +(defvar clipper-file "~/.clipper.el" "File used for saving clipper information.") + +(defvar clipper-input-buffer "*clipper input*" "Buffer used for entering new clips.") + +(defvar clipper-mode-map + (let ((map (make-sparse-keymap))) + (define-key map "\C-c\C-c" 'clipper-complete-input) + map) + "Mode specific keymap for `clipper-mode'.") + +(defvar clipper-mode-string "Clipper" "Mode name for clipper.") + +(defvar clipper-input-message "" "Value for the clipper input buffer.") +(if (equal clipper-input-message "") + (setq clipper-input-message + (concat clipper-input-message + "CLIPPER: --------------------------------------------------------------------------\n" + "CLIPPER: Lines beginning with `CLIPPER:' are removed automatically.\n" + "CLIPPER: Enter new clip. Type C-c C-c when complete.\n" + "CLIPPER: \n" + "CLIPPER: The following variables are supported: \n" + "CLIPPER: \n" + "CLIPPER: CLIPPER_FILE_NAME_NONDIRECTORY\n" + "CLIPPER: \n" + "CLIPPER: The current filename without it's directory. If this buffer isn't\n" + "CLIPPER: backed on disk then the buffer name is used.\n" + "CLIPPER: \n" + "CLIPPER: CLIPPER_FILE_NAME_NONDIRECTORY_SANS_EXTENSION\n" + "CLIPPER: \n" + "CLIPPER: The current filename without it's directory and without an extension\n" + "CLIPPER: \n"))) + +(defun clipper-save() + "Save the clipper information to file." + + (save-excursion + + (let((find-file-hooks nil)) + + (set-buffer (find-file-noselect clipper-file)) + + ;;whatever is in this buffer is now obsolete + (erase-buffer) + + (insert "(setq clipper-alist '") + (prin1 clipper-alist (current-buffer)) + (insert ")") + (save-buffer) + (kill-buffer (current-buffer)) + + (message "Wrote %s" clipper-file)))) + +(defun clipper-delete() + "Delete an existing 'clip'" + (interactive) + + (let (clip) + + ;; get the clipper to delete + (setq clip (clipper-get-clip)) + + (if (yes-or-no-p (format "Are you sure you want to delete clip: %s? " clip)) + (progn + + ;;remove it... + (setq clipper-alist (delq (assoc (intern clip) clipper-alist) clipper-alist)) + + ;;save the alist to disk + (clipper-save))))) + +(defun clipper-create() + "Create a new 'clip' for use within Emacs" + (interactive) + + (set-buffer (get-buffer-create clipper-input-buffer)) + (erase-buffer) ;; just in case + + (clipper-mode) + + (setq clipper-clip-name (read-string "Name of new clip: ")) + + ;;make sure the clip that the user just specified doesn't already exist. + (if (null (assoc (intern clipper-clip-name) clipper-alist)) + (progn + + (insert clipper-input-message) + + (pop-to-buffer clipper-input-buffer) + (goto-char (point-max)) + + (message "Enter new clip. Type C-c C-c when complete.")) + (error "The specified clip already exists"))) + +(defun clipper-complete-input() + "Called when the user is done entering text. " + (interactive) + + (set-buffer (get-buffer-create clipper-input-buffer)) + + ;;make sure font-lock is off in this buffer + (font-lock-mode -1) + + ;;clean up the input buffer by removing comment lines. + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "^CLIPPER: .*$" nil t) + (delete-region (match-beginning 0) (match-end 0)) + (kill-line 1))) + + ;;now get the value of the buffer. + (let(clipper-input begin end) + + (save-excursion + (goto-char (point-min)) + (setq begin (point)) + (goto-char (point-max)) + (setq end (point))) + + (setq clipper-input (buffer-string)) + + (add-to-list 'clipper-alist (cons (intern clipper-clip-name) clipper-input))) + + ;;now clean up... + (kill-buffer clipper-input-buffer) + (delete-window) + + (clipper-save)) + +(defun clipper-insert(clip-name) + "Insert a new 'clip' into the current buffer" + (interactive + (list + (clipper-get-clip))) + + (let (value insert-start insert-end) + + ;;the insert start and insert end variables keep track of where things were + ;;inserted. + + (setq insert-start (point)) + + (setq value (assoc (intern clip-name) clipper-alist)) + + (insert (cdr value)) + + (setq insert-end (point)) + + (clipper-replace-tokens insert-start insert-end))) + +(defun clipper-mode() + "Mode for entering data into a 'clip'." + + (kill-all-local-variables) + (use-local-map clipper-mode-map) + + (setq major-mode 'clipper-mode) + (setq mode-name clipper-mode-string) + + (setq clipper-mode t) + + (run-hooks 'clipper-mode-hook) + (font-lock-mode 1)) + +(defun clipper-restore() + "Read the clipper data file from disk" + (when (file-readable-p clipper-file) + (message "Reading %s..." clipper-file) + + (load-file clipper-file) + + (message "Reading %s...done" clipper-file))) + +(defun clipper-get-clip() + "Use completion to ask the user for a clip" + + ;;build a list for completion + (let((completion-list nil) + (index 1) + (clip-name nil)) + (dolist(clip clipper-alist) + + (setq clip-name (symbol-name (car clip) )) + + (add-to-list 'completion-list + (list clip-name index)) + + (setq index (1+ index))) + + (completing-read "Clip name: " completion-list nil t))) + +(defun clipper-edit-clip(name) + "Edit an existing clip. Note that your clip MUST be saved even if +you don't edit it. Otherwise the clip will be DELETED for good." + (interactive + (list + (clipper-get-clip))) + + (setq clipper-clip-name name) + (set-buffer (get-buffer-create clipper-input-buffer)) + (erase-buffer) + (clipper-mode) + + (insert clipper-input-message) + (setq value (assoc (intern name) clipper-alist)) + (insert (cdr value)) + (pop-to-buffer clipper-input-buffer) + (goto-char (point-min))) + +(defun clipper-replace-tokens(start end) + "Search and replace clipper tokens in this buffer." + + (save-excursion + (save-restriction + + (narrow-to-region start end) + + (goto-char (point-min)) + + (let(file-name-nondirectory file-name-nondirectory-san-extension) + + (if (buffer-file-name) + (setq file-name-nondirectory (file-name-nondirectory (buffer-file-name))) + (setq file-name-nondirectory (buffer-name))) + + (if (null file-name-nondirectory) + (setq file-name-nondirectory (buffer-name))) + + (setq file-name-nondirectory-san-extension (file-name-sans-extension file-name-nondirectory)) + + ;;--------- + ;;setup the file-name-nondirectory extension + (save-excursion + + (goto-char (point-min)) + + (while (re-search-forward " \\(CLIPPER_FILE_NAME_NONDIRECTORY\\) " nil t) + (replace-match file-name-nondirectory t nil nil 1))) + + ;;--------- + (save-excursion + + (goto-char (point-min)) + + (while (re-search-forward "\\(CLIPPER_FILE_NAME_NONDIRECTORY_SANS_EXTENSION\\)" nil t) + + (replace-match file-name-nondirectory-san-extension t nil nil 1))))))) + +;;initialze clipper +(clipper-restore) + +(font-lock-add-keywords 'clipper-mode '(("\\(^CLIPPER.*\\)" 1 'font-lock-comment-face t))) + +(provide 'clipper) + +;;; clipper.el ends here diff --git a/elisp/emacs-goodies-el/coffee.el b/elisp/emacs-goodies-el/coffee.el new file mode 100755 index 0000000..b9a9f06 --- /dev/null +++ b/elisp/emacs-goodies-el/coffee.el @@ -0,0 +1,115 @@ +;;; coffee.el --- Submit a BREW request to an RFC2324-compliant coffee device +;;; +;;; Author: Eric Marsden +;;; Version: 0.3 +;;; Copyright: (C) 1999, 2003 Eric Marsden +;;; Keywords: coffee, brew, kitchen-sink, can't +;; +;; 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. +;; +;; Please send suggestions and bug reports to . +;; The latest version of this package should be available at +;; +;; + +;;; Commentary: +;; +;; This module provides an Emacs interface to RFC2324-compliant coffee +;; devices (Hyper Text Coffee Pot Control Protocol, or HTCPCP). It +;; prompts the user for the different additives, then issues a BREW +;; request to the coffee device. +;; +;; coffee.el requires a special BREW-capable version of Emacs/W3 to be +;; installed. +;; +;; Reference: +;; +;; +;; Thanks to Giacomo Boffi for some typos +;; and the addition of the "Brown-Coffee" sweetener type. + +;;; Code: + +(require 'cl) + +(defvar coffee-host "coffee" + "*The host which provides the coffee service.") + +(defvar coffee-pot-designator 1 + "*On machines with multiple pots, the number of the pot to brew in") + +(defvar coffee-brew-hook nil + "*Hook executed before issuing a BREW request") + +(defconst coffee-milk-types + '("Cream" "Half-and-Half" "Whole-Milk" "Part-Skim" "Skim" "Non-Dairy")) + +(defconst coffee-syrup-types '("Vanilla" "Almond" "Raspberry" "Chocolate")) + +(defconst coffee-sweetener-types '("White-Sugar" "Brown-Sugar" "Artificial-Sweetener")) + +(defconst coffee-alcohol-types '("Whiskey" "Rum" "Kahula" "Aquavit")) + +(defconst coffee-addition-types + `(("Milk" . ,coffee-milk-types) + ("Syrup" . ,coffee-syrup-types) + ("Sweetener" . ,coffee-sweetener-types) + ("Alcohol" . ,coffee-alcohol-types))) + +;;;###autoload +(defun coffee () + "Submit a BREW request to an RFC2324-compliant coffee device" + (interactive) + (require 'url) + (let* ((additions-list + (append coffee-milk-types + coffee-syrup-types + coffee-sweetener-types + coffee-alcohol-types)) + (additions-string + (mapconcat #'identity additions-list ",")) + (url (coffee-url)) + (url-request-method "BREW") + (url-request-extra-headers + `(("Content-type" . "message-coffeepot") + ("Accept-Additions" . ,additions-string))) + (url-request-data "START")) + (run-hooks 'coffee-brew-hook) + (url-retrieve url (lambda () (coffee-drink))))) + +(defun coffee-additions () + (let* ((type-name + (completing-read "Coffee addition: " coffee-addition-types nil t)) + (type (cdr (assoc type-name coffee-addition-types))) + (ingredients (mapcar #'(lambda (a) (cons a a)) type)) + (ingredient + (completing-read "Addition type: " ingredients nil t))) + ingredient)) + +(defun coffee-url () + (require 'w3-forms) + (concat "coffee://" coffee-host "/" + (int-to-string coffee-pot-designator) + "?" (w3-form-encode-xwfu (coffee-additions)))) + + +(defun coffee-drink () + (sleep-for -1)) + + +(provide 'coffee) + +;; coffee.el ends here diff --git a/elisp/emacs-goodies-el/color-theme-library.el b/elisp/emacs-goodies-el/color-theme-library.el new file mode 100755 index 0000000..d194708 --- /dev/null +++ b/elisp/emacs-goodies-el/color-theme-library.el @@ -0,0 +1,13539 @@ +;;; 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/elisp/emacs-goodies-el/color-theme.el b/elisp/emacs-goodies-el/color-theme.el new file mode 100755 index 0000000..3b33942 --- /dev/null +++ b/elisp/emacs-goodies-el/color-theme.el @@ -0,0 +1,1669 @@ +;;; 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 +(if (fboundp 'replace-in-string) + (defalias 'color-theme-replace-in-string 'replace-in-string) + (defsubst color-theme-replace-in-string (target old new &optional literal) + (replace-regexp-in-string old new target nil literal))) + +;; 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 + (color-theme-replace-in-string + (color-theme-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/elisp/emacs-goodies-el/color-theme_seldefcustom.el b/elisp/emacs-goodies-el/color-theme_seldefcustom.el new file mode 100755 index 0000000..2cf097d --- /dev/null +++ b/elisp/emacs-goodies-el/color-theme_seldefcustom.el @@ -0,0 +1,49 @@ +;;; color-theme_seldefcustom.el --- color-theme selection via customize interface +;;; Commentary: +;; +;; Peter S Galbraith , 2005-10-25 +;; License: GPLV2 or later. + +;; A color-theme can can selected and enabled for future sessions by +;; customizing the variable `color-theme-selection' and saving the setting +;; instead of calling the interactive command `color-theme-select' + +;;; Code: + +(require 'color-theme) + +(defcustom color-theme-selection nil + "Color theme selection. +Select and save to enable your choice in future sessions. +There is very limited undo capability to the previous state only." + :type (progn + (setq color-themes (delq (assq 'color-theme-snapshot color-themes) + color-themes) + color-themes (delq (assq 'bury-buffer color-themes) + color-themes)) + (append + '(radio) + (cons '(const :tag "Undo" nil) + (mapcar (function (lambda (arg) `(const ,arg))) + (mapcar '(lambda (x) (elt x 1)) color-themes))))) + :set (lambda (symbol value) + (set-default symbol value) + (require 'color-theme) ; :load doesn't seem to work + (unless color-theme-initialized (color-theme-initialize)) + (cond + (value + (fset 'color-theme-snapshot (color-theme-make-snapshot)) + (eval + (delq nil + (mapcar + '(lambda (x) (if (string-equal (elt x 1) value) + (car x))) + color-themes)))) + ((fboundp 'color-theme-snapshot) + (color-theme-snapshot)))) + :group 'color-theme + :require 'color-theme_seldefcustom) + +(provide 'color-theme_seldefcustom) + +;;; color-theme_seldefcustom.el ends here diff --git a/elisp/emacs-goodies-el/csv-mode.el b/elisp/emacs-goodies-el/csv-mode.el new file mode 100755 index 0000000..8a44619 --- /dev/null +++ b/elisp/emacs-goodies-el/csv-mode.el @@ -0,0 +1,1286 @@ +;;; csv-mode.el --- major mode for editing comma-separated value files + +;; Copyright (C) 2003, 2004 Francis J. Wright + +;; Author: Francis J. Wright +;; Time-stamp: <23 August 2004> +;; URL: http://centaur.maths.qmul.ac.uk/Emacs/ +;; Version: $Id: csv-mode.el,v 1.1 2005-09-28 01:52:41 psg Exp $ +;; Keywords: convenience + +;; This file is not part of GNU Emacs. + +;; This package 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 package 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 package is intended for use with GNU Emacs 21 (only) and +;; implements the following commands to process records of CSV +;; (comma-separated value) type: `csv-sort-fields' and +;; `csv-sort-numeric-fields' sort respectively lexicographically and +;; numerically on a specified field or column; `csv-reverse-region' +;; reverses the order. They are based closely on, and use, code in +;; `sort.el'. `csv-kill-fields' and `csv-yank-fields' respectively +;; kill and yank fields or columns, although they do not use the +;; normal kill ring. `csv-kill-fields' can kill more than one field +;; at once, but multiple killed fields can be yanked only as a fixed +;; group equivalent to a single field. `csv-align-fields' aligns +;; fields into columns; `csv-unalign-fields' undoes such alignment; +;; separators can be hidden within aligned records. `csv-transpose' +;; interchanges rows and columns. For details, see the documentation +;; for the individual commands. + +;; CSV mode supports a generalised comma-separated values format +;; (character-separated values) in which the fields can be separated +;; by any of several single characters, specified by the value of the +;; customizable user option `csv-separators'. CSV data fields can be +;; delimited by quote characters (and must if they contain separator +;; characters). This implementation supports quoted fields, where the +;; quote characters allowed are specified by the value of the +;; customizable user option `csv-field-quotes'. By default, the only +;; separator is a comma and the only field quote is a double quote. +;; These user options can be changed ONLY by CUSTOMIZING them, +;; e.g. via the command `customize-variable'. + +;; CSV mode commands ignore blank lines and comment lines beginning +;; with the value of the buffer local variable `csv-comment-start', +;; which by default is #. The user interface is similar to that of +;; the standard commands `sort-fields' and `sort-numeric-fields', but +;; see the major mode documentation below. + +;; The global minor mode `csv-field-index-mode' provides display of +;; the current field index in the mode line, cf. `line-number-mode' +;; and `column-number-mode'. It is on by default. + +;;; Installation: + +;; Put this file somewhere that Emacs can find it (i.e. in one of the +;; directories in your `load-path' such as `site-lisp'), optionally +;; byte-compile it (recommended), and put this in your .emacs file: +;; +;; (add-to-list 'auto-mode-alist '("\\.[Cc][Ss][Vv]\\'" . csv-mode)) +;; (autoload 'csv-mode "csv-mode" +;; "Major mode for editing comma-separated value files." t) + +;;; History: + +;; Begun on 15 November 2003 to provide lexicographic sorting of +;; simple CSV data by field and released as csv.el. Facilities to +;; kill multiple fields and customize separator added on 9 April 2004. +;; Converted to a major mode and renamed csv-mode.el on 10 April 2004, +;; partly at the suggestion of Stefan Monnier to avoid conflict with csv.el by Ulf Jasper. +;; Field alignment, comment support and CSV mode customization group +;; added on 1 May 2004. Support for index ranges added on 6 June +;; 2004. Multiple field separators added on 12 June 2004. +;; Transposition added on 22 June 2004. Separator invisibility added +;; on 23 June 2004. + +;;; See also: + +;; the standard GNU Emacs 21 packages align.el, which will align +;; columns within a region, and delim-col.el, which helps to prettify +;; columns in a text region or rectangle; + +;; csv.el by Ulf Jasper , which provides +;; functions for reading/parsing comma-separated value files and is +;; available at http://de.geocities.com/ulf_jasper/emacs.html (and in +;; the gnu.emacs.sources archives). + +;;; To do (maybe): + +;; Make separators and quotes buffer-local and locally settable. +;; Support (La)TeX tables: set separator and comment; support record +;; end string. +;; Convert comma-separated to space- or tab-separated. + +;;; Code: + +(defgroup CSV nil + "Major mode for editing files of comma-separated value type." + :group 'convenience) + +(defvar csv-separator-chars nil + "Field separators as a list of character. +Set by customizing `csv-separators' -- do not set directly!") + +(defvar csv-separator-regexp nil + "Regexp to match a field separator. +Set by customizing `csv-separators' -- do not set directly!") + +(defvar csv-skip-regexp nil + "Regexp used by `skip-chars-forward' etc. to skip fields. +Set by customizing `csv-separators' -- do not set directly!") + +(defvar csv-font-lock-keywords nil + "Font lock keywords to highlight the field separators in CSV mode. +Set by customizing `csv-separators' -- do not set directly!") + +(defcustom csv-separators '(",") + "Field separators: a list of *single-character* strings. +For example: (\",\"), the default, or (\",\" \";\" \":\"). +Neighbouring fields may be separated by any one of these characters. +The first is used when inserting a field separator into the buffer. +All must be different from the field quote characters, `csv-field-quotes'." + ;; Suggested by Eckhard Neber + :group 'CSV + :type '(repeat string) + ;; Character would be better, but in Emacs 21.3 does not display + ;; correctly in a customization buffer. + :set (lambda (variable value) + (mapc (lambda (x) + (if (or (/= (length x) 1) + (and (boundp 'csv-field-quotes) + (member x csv-field-quotes))) + (error))) + value) + (custom-set-default variable value) + (setq csv-separator-chars (mapcar 'string-to-char value) + csv-skip-regexp (apply 'concat "^\n" csv-separators) + csv-separator-regexp (apply 'concat `("[" ,@value "]")) + csv-font-lock-keywords + ;; NB: csv-separator-face variable evaluates to itself. + `((,csv-separator-regexp . csv-separator-face))))) + +(defcustom csv-field-quotes '("\"") + "Field quotes: a list of *single-character* strings. +For example: (\"\\\"\"), the default, or (\"\\\"\" \"'\" \"`\"). +A field can be delimited by a pair of any of these characters. +All must be different from the field separators, `csv-separators'." + :group 'CSV + :type '(repeat string) + ;; Character would be better, but in Emacs 21 does not display + ;; correctly in a customization buffer. + :set (lambda (variable value) + (mapc (lambda (x) + (if (or (/= (length x) 1) + (member x csv-separators)) + (error))) + value) + (when (boundp 'csv-mode-syntax-table) + ;; FIRST remove old quote syntax: + (with-syntax-table text-mode-syntax-table + (mapc (lambda (x) + (modify-syntax-entry + (string-to-char x) + (string (char-syntax (string-to-char x))) + ;; symbol-value to avoid compiler warning: + (symbol-value 'csv-mode-syntax-table))) + csv-field-quotes)) + ;; THEN set new quote syntax: + (csv-set-quote-syntax value)) + ;; BEFORE setting new value of `csv-field-quotes': + (custom-set-default variable value))) + +(defun csv-set-quote-syntax (field-quotes) + "Set syntax for field quote characters FIELD-QUOTES to be \"string\". +FIELD-QUOTES should be a list of single-character strings." + (mapc (lambda (x) + (modify-syntax-entry + (string-to-char x) "\"" + ;; symbol-value to avoid compiler warning: + (symbol-value 'csv-mode-syntax-table))) + field-quotes)) + +(defvar csv-comment-start nil + "String that starts a comment line, or nil if no comment syntax. +Such comment lines are ignored by CSV mode commands. +This variable is buffer local\; its default value is that of +`csv-comment-start-default'. It is set by the function +`csv-set-comment-start' -- do not set it directly!") + +(make-variable-buffer-local 'csv-comment-start) + +(defcustom csv-comment-start-default "#" + "String that starts a comment line, or nil if no comment syntax. +Such comment lines are ignored by CSV mode commands. +Default value of buffer-local variable `csv-comment-start'. +Changing this variable does not affect any existing CSV mode buffer." + :group 'CSV + :type '(choice (const :tag "None" nil) string) + :set (lambda (variable value) + (custom-set-default variable value) + (set-default 'csv-comment-start value))) + +(defcustom csv-align-style 'left + "Aligned field style: one of 'left, 'centre, 'right or 'auto. +Alignment style used by `csv-align-fields'. +Auto-alignment means left align text and right align numbers." + :group 'CSV + :type '(choice (const left) (const centre) + (const right) (const auto))) + +(defcustom csv-align-padding 1 + "Aligned field spacing: must be a positive integer. +Number of spaces used by `csv-align-fields' after separators." + :group 'CSV + :type 'integer) + +(defcustom csv-header-lines 0 + "Header lines to skip when setting region automatically." + :group 'CSV + :type 'integer) + +(defcustom csv-invisibility-default nil + "If non-nil, make separators in aligned records invisible." + :group 'CSV + :type 'boolean) + +(defface csv-separator-face + '((((class color)) (:foreground "red")) + (t (:weight bold))) + "CSV mode face used to highlight separators." + :group 'CSV) + +;; This mechanism seems to keep XEmacs happy: +(defvar csv-separator-face 'csv-separator-face + "Face name to use to highlight separators.") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Mode definition, key bindings and menu +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defconst csv-mode-line-help-echo + ;; See bindings.el for details of `mode-line-format' construction. + (get-text-property 0 'help-echo (car default-mode-line-format)) + "Primary default mode line help echo text.") + +(defconst csv-mode-line-format + ;; See bindings.el for details of `mode-line-format' construction. + (append (butlast default-mode-line-format 2) + (cons `(csv-field-index-string + ("" csv-field-index-string + ,(propertize "--" 'help-echo csv-mode-line-help-echo))) + (last default-mode-line-format 2))) + "Mode line format string for CSV mode.") + +(define-derived-mode csv-mode text-mode "CSV" + "Major mode for editing files of comma-separated value type. + +CSV mode is derived from `text-mode', and runs `text-mode-hook' before +running `csv-mode-hook'. It turns `auto-fill-mode' off by default. +CSV mode can be customized by user options in the CSV customization +group. The separators are specified by the value of `csv-separators'. + +CSV mode commands ignore blank lines and comment lines beginning with +the value of `csv-comment-start', which delimit \"paragraphs\". +\"Sexp\" is re-interpreted to mean \"field\", so that `forward-sexp' +\(\\[forward-sexp]), `kill-sexp' (\\[kill-sexp]), etc. all apply to fields. +Standard comment commands apply, such as `comment-dwim' (\\[comment-dwim]). + +If `font-lock-mode' is enabled then separators, quoted values and +comment lines are highlighted using respectively `csv-separator-face', +`font-lock-string-face' and `font-lock-comment-face'. + +The user interface (UI) for CSV mode commands is similar to that of +the standard commands `sort-fields' and `sort-numeric-fields', except +that if there is no prefix argument then the UI prompts for the field +index or indices. In `transient-mark-mode' only: if the region is not +set then the UI attempts to set it to include all consecutive CSV +records around point, and prompts for confirmation; if there is no +prefix argument then the UI prompts for it, offering as a default the +index of the field containing point if the region was not set +explicitly. The region set automatically is delimited by blank lines +and comment lines, and the number of header lines at the beginning of +the region given by the value of `csv-header-lines' are skipped. + +Sort order is controlled by `csv-descending'. + +CSV mode provides the following specific keyboard key bindings: + +\\{csv-mode-map}" + (turn-off-auto-fill) + ;; Set syntax for field quotes: + (csv-set-quote-syntax csv-field-quotes) + ;; Make sexp functions apply to fields: + (set (make-local-variable 'forward-sexp-function) 'csv-forward-field) + ;; Paragraph means a group of contiguous records: + (make-local-variable 'paragraph-separate) + (make-local-variable 'paragraph-start) + ;; Comment support: + (make-local-variable 'comment-start) + (csv-set-comment-start csv-comment-start) + (setq + ;; Font locking -- separator plus syntactic: + font-lock-defaults '(csv-font-lock-keywords) + buffer-invisibility-spec csv-invisibility-default + ;; Mode line to support `csv-field-index-mode': + mode-line-format csv-mode-line-format) + ;; Enable or disable `csv-field-index-mode' (could probably do this + ;; a bit more efficiently): + (csv-field-index-mode (symbol-value 'csv-field-index-mode))) + +(defun csv-set-comment-start (string) + "Set comment start for this CSV mode buffer to STRING. +It must be either a string or nil." + (interactive + (list (edit-and-eval-command + "Comment start (string or nil): " csv-comment-start))) + (setq csv-comment-start string + paragraph-separate "[:space:]*$" ; white space + paragraph-start "\n") ; must include \n explicitly! + (if string + (progn + (setq paragraph-separate (concat paragraph-separate "\\|" string) + paragraph-start (concat paragraph-start "\\|" string) + comment-start string) + (modify-syntax-entry + (string-to-char string) "<" csv-mode-syntax-table) + (modify-syntax-entry ?\n ">" csv-mode-syntax-table)) + (with-syntax-table text-mode-syntax-table + (modify-syntax-entry (string-to-char string) + (string (char-syntax (string-to-char string))) + csv-mode-syntax-table) + (modify-syntax-entry ?\n + (string (char-syntax ?\n)) + csv-mode-syntax-table)))) + +(add-to-list 'auto-mode-alist '("\\.[Cc][Ss][Vv]\\'" . csv-mode)) + +(define-key csv-mode-map [(control ?c) (control ?v)] 'csv-toggle-invisibility) +(define-key csv-mode-map [(control ?c) (control ?t)] 'csv-transpose) +(define-key csv-mode-map [(control ?c) (control ?c)] 'csv-set-comment-start) +(define-key csv-mode-map [(control ?c) (control ?u)] 'csv-unalign-fields) +(define-key csv-mode-map [(control ?c) (control ?a)] 'csv-align-fields) +(define-key csv-mode-map [(control ?c) (control ?z)] 'csv-yank-as-new-table) +(define-key csv-mode-map [(control ?c) (control ?y)] 'csv-yank-fields) +(define-key csv-mode-map [(control ?c) (control ?k)] 'csv-kill-fields) +(define-key csv-mode-map [(control ?c) (control ?d)] 'csv-toggle-descending) +(define-key csv-mode-map [(control ?c) (control ?r)] 'csv-reverse-region) +(define-key csv-mode-map [(control ?c) (control ?n)] 'csv-sort-numeric-fields) +(define-key csv-mode-map [(control ?c) (control ?s)] 'csv-sort-fields) + +(defvar csv-descending nil + "If non-nil, CSV mode sort functions sort in order of descending sort key. +Usually they sort in order of ascending sort key.") + +(defun csv-toggle-descending () + "Toggle `csv-descending'." + (interactive) + (setq csv-descending (not csv-descending)) + (message "Sort order is %sscending" (if csv-descending "de" "a"))) + +(defun csv-toggle-invisibility () + "Toggle `buffer-invisibility-spec'." + (interactive) + (setq buffer-invisibility-spec (not buffer-invisibility-spec)) + (message "Separators in aligned records will be %svisible \ +\(after re-aligning if soft\)" + (if buffer-invisibility-spec "in" "")) + (redraw-frame (selected-frame))) + +(easy-menu-define + csv-menu + csv-mode-map + "CSV major mode menu keymap" + '("CSV" + ["Sort By Field Lexicographically" csv-sort-fields :active t + :help "Sort lines in region lexicographically by the specified field"] + ["Sort By Field Numerically" csv-sort-numeric-fields :active t + :help "Sort lines in region numerically by the specified field"] + ["Reverse Order of Lines" csv-reverse-region :active t + :help "Reverse the order of the lines in the region"] + ["Use Descending Sort Order" csv-toggle-descending :active t + :style toggle :selected csv-descending + :help "If selected, use descending order when sorting"] + "--" + ["Kill Fields (Columns)" csv-kill-fields :active t + :help "Kill specified fields of each line in the region"] + ["Yank Fields (Columns)" csv-yank-fields :active t + :help "Yank killed fields as specified field of each line in region"] + ["Yank As New Table" csv-yank-as-new-table :active t + :help "Yank killed fields as a new table at point"] + ["Align Fields into Columns" csv-align-fields :active t + :help "Align the start of every field of each line in the region"] + ["Unalign Columns into Fields" csv-unalign-fields :active t + :help "Undo soft alignment and optionally remove redundant white space"] + ["Transpose Rows and Columns" csv-transpose :active t + :help "Rewrite rows (which may have different lengths) as columns"] + "--" + ["Forward Field" forward-sexp :active t + :help "Move forward across one field\; with ARG, do it that many times"] + ["Backward Field" backward-sexp :active t + :help "Move backward across one field\; with ARG, do it that many times"] + ["Kill Field Forward" kill-sexp :active t + :help "Kill field following cursor\; with ARG, do it that many times"] + ["Kill Field Backward" backward-kill-sexp :active t + :help "Kill field preceding cursor\; with ARG, do it that many times"] + "--" + ("Alignment Style" + ["Left" (setq csv-align-style 'left) :active t + :style radio :selected (eq csv-align-style 'left) + :help "If selected, `csv-align-fields' left aligns fields"] + ["Centre" (setq csv-align-style 'centre) :active t + :style radio :selected (eq csv-align-style 'centre) + :help "If selected, `csv-align-fields' centres fields"] + ["Right" (setq csv-align-style 'right) :active t + :style radio :selected (eq csv-align-style 'right) + :help "If selected, `csv-align-fields' right aligns fields"] + ["Auto" (setq csv-align-style 'auto) :active t + :style radio :selected (eq csv-align-style 'auto) + :help "\ +If selected, `csv-align-fields' left aligns text and right aligns numbers"] + ) + ["Show Current Field Index" csv-field-index-mode :active t + :style toggle :selected csv-field-index-mode + :help "If selected, display current field index in mode line"] + ["Make Separators Invisible" csv-toggle-invisibility :active t + :style toggle :selected buffer-invisibility-spec + :help "If selected, separators in aligned records are invisible"] + ["Set Buffer's Comment Start" csv-set-comment-start :active t + :help "Set comment start string for this buffer"] + ["Customize CSV Mode" (customize-group 'CSV) :active t + :help "Open a customization buffer to change CSV mode options"] + )) + +(require 'sort) + +(defsubst csv-not-looking-at-record () + "Return t if looking at blank or comment line, nil otherwise. +Assumes point is at beginning of line." + (looking-at paragraph-separate)) + +(defun csv-interactive-args (&optional type) + "Get arg or field(s) and region interactively, offering sensible defaults. +Signal an error if the buffer is read-only. +If TYPE is noarg then return a list `(beg end)'. +Otherwise, return a list `(arg beg end)', where arg is: + the raw prefix argument by default\; + a single field index if TYPE is single\; + a list of field indices or index ranges if TYPE is multiple. +Field defaults to the current prefix arg\; if not set, prompt user. + +A field index list consists of positive or negative integers or ranges, +separated by any non-integer characters. A range has the form m-n, +where m and n are positive or negative integers, m < n, and n defaults +to the last field index if omitted. + +In transient mark mode, if the mark is not active then automatically +select and highlight CSV records around point, and query user. +The default field when read interactively is the current field." + ;; Must be run interactively to activate mark! + (let* ((arg current-prefix-arg) (default-field 1) + (region + (if (and transient-mark-mode (not mark-active)) + ;; Set region automatically: + (save-excursion + (let (startline lbp) + (if arg + (beginning-of-line) + (setq lbp (line-beginning-position)) + (while (re-search-backward csv-separator-regexp lbp 1) + ;; Move as far as possible, i.e. to beginning of line. + (setq default-field (1+ default-field)))) + (if (csv-not-looking-at-record) + (error "Point may not be within CSV records")) + (setq startline (point)) + ;; Set mark at beginning of region: + (while (not (or (bobp) (csv-not-looking-at-record))) + (forward-line -1)) + (if (csv-not-looking-at-record) (forward-line 1)) + ;; Skip header lines: + (forward-line csv-header-lines) + (set-mark (point)) ; OK since in save-excursion + ;; Move point to end of region: + (goto-char startline) + (beginning-of-line) + (while (not (or (eobp) (csv-not-looking-at-record))) + (forward-line 1)) + ;; Show mark briefly if necessary: + (unless (and (pos-visible-in-window-p) + (pos-visible-in-window-p (mark))) + (exchange-point-and-mark) + (sit-for 1) + (exchange-point-and-mark)) + (or (y-or-n-p "Region OK? ") + (error "Action aborted by user")) + (message nil) ; clear y-or-n-p message + (list (region-beginning) (region-end)))) + ;; Use region set by user: + (list (region-beginning) (region-end))))) + (setq default-field (number-to-string default-field)) + (cond + ((eq type 'multiple) + (if arg + ;; Ensure that field is a list: + (or (consp arg) + (setq arg (list (prefix-numeric-value arg)))) + ;; Read field interactively, ignoring non-integers: + (setq arg + (mapcar + (lambda (x) + (if (string-match "-" x 1) ; not first character + ;; Return a range as a pair - the cdr may be nil: + (let ((m (substring x 0 (match-beginning 0))) + (n (substring x (match-end 0)))) + (cons (car (read-from-string m)) + (and (not (string= n "")) + (car (read-from-string n))))) + ;; Return a number as a number: + (car (read-from-string x)))) + (split-string + (read-string + "Fields (sequence of integers or ranges): " default-field) + "[^-+0-9]+"))))) + ((eq type 'single) + (if arg + (setq arg (prefix-numeric-value arg)) + (while (not (integerp arg)) + (setq arg (eval-minibuffer "Field (integer): " default-field)))))) + (if (eq type 'noarg) region (cons arg region)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Sorting by field +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun csv-nextrecfun () + "Called by `csv-sort-fields-1' with point at end of previous record. +It moves point to the start of the next record. +It should move point to the end of the buffer if there are no more records." + (forward-line) + (while (and (not (eobp)) (csv-not-looking-at-record)) + (forward-line))) + +(defun csv-sort-fields-1 (field beg end startkeyfun endkeyfun) + "Modified version of `sort-fields-1' that skips blank or comment lines. + +FIELD is a single field index, and BEG and END specify the region to +sort. + +STARTKEYFUN moves from the start of the record to the start of the key. +It may return either a non-nil value to be used as the key, or +else the key is the substring between the values of point after +STARTKEYFUN and ENDKEYFUN are called. If STARTKEYFUN is nil, the key +starts at the beginning of the record. + +ENDKEYFUN moves from the start of the sort key to the end of the sort key. +ENDKEYFUN may be nil if STARTKEYFUN returns a value or if it would be the +same as ENDRECFUN." + (let ((tbl (syntax-table))) + (if (zerop field) (setq field 1)) + (unwind-protect + (save-excursion + (save-restriction + (narrow-to-region beg end) + (goto-char (point-min)) + (set-syntax-table sort-fields-syntax-table) + (sort-subr csv-descending + 'csv-nextrecfun 'end-of-line + startkeyfun endkeyfun))) + (set-syntax-table tbl)))) + +(defun csv-sort-fields (field beg end) + "Sort lines in region lexicographically by the ARGth field of each line. +If not set, the region defaults to the CSV records around point. +Fields are separated by `csv-separators' and null fields are allowed anywhere. +Field indices increase from 1 on the left or decrease from -1 on the right. +A prefix argument specifies a single field, otherwise prompt for field index. +Ignore blank and comment lines. The variable `sort-fold-case' +determines whether alphabetic case affects the sort order. +When called non-interactively, FIELD is a single field index\; +BEG and END specify the region to sort." + ;; (interactive "*P\nr") + (interactive (csv-interactive-args 'single)) + (barf-if-buffer-read-only) + (csv-sort-fields-1 field beg end + (lambda () (csv-sort-skip-fields field) nil) + (lambda () (skip-chars-forward csv-skip-regexp)))) + +(defun csv-sort-numeric-fields (field beg end) + "Sort lines in region numerically by the ARGth field of each line. +If not set, the region defaults to the CSV records around point. +Fields are separated by `csv-separators'. +Null fields are allowed anywhere and sort as zeros. +Field indices increase from 1 on the left or decrease from -1 on the right. +A prefix argument specifies a single field, otherwise prompt for field index. +Specified non-null field must contain a number in each line of the region, +which may begin with \"0x\" or \"0\" for hexadecimal and octal values. +Otherwise, the number is interpreted according to sort-numeric-base. +Ignore blank and comment lines. +When called non-interactively, FIELD is a single field index\; +BEG and END specify the region to sort." + ;; (interactive "*P\nr") + (interactive (csv-interactive-args 'single)) + (barf-if-buffer-read-only) + (csv-sort-fields-1 field beg end + (lambda () + (csv-sort-skip-fields field) + (let* ((case-fold-search t) + (base + (if (looking-at "\\(0x\\)[0-9a-f]\\|\\(0\\)[0-7]") + (cond ((match-beginning 1) + (goto-char (match-end 1)) + 16) + ((match-beginning 2) + (goto-char (match-end 2)) + 8) + (t nil))))) + (string-to-number (buffer-substring (point) + (save-excursion + (forward-sexp 1) + (point))) + (or base sort-numeric-base)))) + nil)) + +(defun csv-reverse-region (beg end) + "Reverse the order of the lines in the region. +This is just a CSV-mode style interface to `reverse-region', which is +the function that should be used non-interactively. It takes two +point or marker arguments, BEG and END, delimiting the region." + ;; (interactive "*P\nr") + (interactive (csv-interactive-args 'noarg)) + (barf-if-buffer-read-only) + (reverse-region beg end)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Moving by field +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defsubst csv-end-of-field () + "Skip forward over one field." + (skip-syntax-forward " ") + (if (eq (char-syntax (following-char)) ?\") + (goto-char (scan-sexps (point) 1))) + (skip-chars-forward csv-skip-regexp)) + +(defsubst csv-beginning-of-field () + "Skip backward over one field." + (skip-syntax-backward " ") + (if (eq (char-syntax (preceding-char)) ?\") + (goto-char (scan-sexps (point) -1))) + (skip-chars-backward csv-skip-regexp)) + +(defun csv-forward-field (arg) + "Move forward across one field, cf. `forward-sexp'. +With ARG, do it that many times. Negative arg -N means +move backward across N fields." + (interactive "p") + (if (< arg 0) + (csv-backward-field (- arg)) + (while (>= (setq arg (1- arg)) 0) + (if (or (bolp) + (when (and (not (eobp)) (eolp)) (forward-char) t)) + (while (and (not (eobp)) (csv-not-looking-at-record)) + (forward-line 1))) + (if (memq (following-char) csv-separator-chars) (forward-char)) + (csv-end-of-field)))) + +(defun csv-backward-field (arg) + "Move backward across one field, cf. `backward-sexp'. +With ARG, do it that many times. Negative arg -N means +move forward across N fields." + (interactive "p") + (if (< arg 0) + (csv-forward-field (- arg)) + (while (>= (setq arg (1- arg)) 0) + (when (or (eolp) + (when (and (not (bobp)) (bolp)) (backward-char) t)) + (while (progn + (beginning-of-line) + (csv-not-looking-at-record)) + (backward-char)) + (end-of-line)) + (if (memq (preceding-char) csv-separator-chars) (backward-char)) + (csv-beginning-of-field)))) + +(defun csv-sort-skip-fields (n &optional yank) + "Position point at the beginning of field N on the current line. +Fields are separated by `csv-separators'\; null terminal field allowed. +Assumes point is initially at the beginning of the line. +YANK non-nil allows N to be greater than the number of fields, in +which case extend the record as necessary." + (if (> n 0) + ;; Skip across N - 1 fields. + (let ((i (1- n))) + (while (> i 0) + (csv-end-of-field) + (if (eolp) + (if yank + (if (> i 1) (insert (car csv-separators))) + (error "Line has too few fields: %s" + (buffer-substring + (save-excursion (beginning-of-line) (point)) + (save-excursion (end-of-line) (point))))) + (forward-char)) ; skip separator + (setq i (1- i)))) + (end-of-line) + ;; Skip back across -N - 1 fields. + (let ((i (1- (- n)))) + (while (> i 0) + (csv-beginning-of-field) + (if (bolp) + (error "Line has too few fields: %s" + (buffer-substring + (save-excursion (beginning-of-line) (point)) + (save-excursion (end-of-line) (point))))) + (backward-char) ; skip separator + (setq i (1- i))) + ;; Position at the front of the field + ;; even if moving backwards. + (csv-beginning-of-field)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Field index mode +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; Based partly on paren.el + +(defcustom csv-field-index-delay 0.125 + "Time in seconds to delay before updating field index display." + :group 'CSV + :type '(number :tag "seconds")) + +(defvar csv-field-index-idle-timer nil) + +(defvar csv-field-index-string nil) +(make-variable-buffer-local 'csv-field-index-string) + +(defvar csv-field-index-old nil) +(make-variable-buffer-local 'csv-field-index-old) + +(define-minor-mode csv-field-index-mode + "Toggle CSV-Field-Index mode. +With prefix ARG, turn CSV-Field-Index mode on if and only if ARG is positive. +Returns the new status of CSV-Field-Index mode (non-nil means on). +When CSV-Field-Index mode is enabled, the current field index appears in +the mode line after `csv-field-index-delay' seconds of Emacs idle time." + :group 'CSV + :global t + :init-value t ; for documentation, since default is t + ;; This macro generates a function that first sets the mode + ;; variable, then runs the following code, runs the mode hooks, + ;; displays a message if interactive, updates the mode line and + ;; finally returns the variable value. + + ;; First, always disable the mechanism (to avoid having two timers): + (when csv-field-index-idle-timer + (cancel-timer csv-field-index-idle-timer) + (setq csv-field-index-idle-timer nil)) + ;; Now, if the mode is on and any buffer is in CSV mode then + ;; re-initialize and enable the mechanism by setting up a new timer: + (if csv-field-index-mode + (if (memq t (mapcar (lambda (buffer) + (with-current-buffer buffer + (when (eq major-mode 'csv-mode) + (setq csv-field-index-string nil + csv-field-index-old nil) + t))) + (buffer-list))) + (setq csv-field-index-idle-timer + (run-with-idle-timer csv-field-index-delay t + 'csv-field-index))) + ;; but if the mode is off then remove the display from the mode + ;; lines of all CSV buffers: + (mapc (lambda (buffer) + (with-current-buffer buffer + (when (eq major-mode 'csv-mode) + (setq csv-field-index-string nil + csv-field-index-old nil) + (force-mode-line-update)))) + (buffer-list)))) + +(defun csv-field-index () + "Construct `csv-field-index-string' to display in mode line. +Called by `csv-field-index-idle-timer'." + (if (eq major-mode 'csv-mode) + (save-excursion + (let ((lbp (line-beginning-position)) (field 1)) + (while (re-search-backward csv-separator-regexp lbp 1) + ;; Move as far as possible, i.e. to beginning of line. + (setq field (1+ field))) + (if (csv-not-looking-at-record) (setq field nil)) + (when (not (eq field csv-field-index-old)) + (setq csv-field-index-old field + csv-field-index-string + (and field (propertize (format "F%d" field) + 'help-echo csv-mode-line-help-echo))) + (force-mode-line-update)))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Killing and yanking fields +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defvar csv-killed-fields nil + "A list of the fields or sub-records last killed by `csv-kill-fields'.") + +(defun csv-kill-fields (fields beg end) + "Kill specified fields of each line in the region. +If not set, the region defaults to the CSV records around point. +Fields are separated by `csv-separators' and null fields are allowed anywhere. +Field indices increase from 1 on the left or decrease from -1 on the right. +The fields are stored for use by `csv-yank-fields'. Fields can be +specified in any order but are saved in increasing index order. +Ignore blank and comment lines. + +When called interactively, a prefix argument specifies a single field, +otherwise prompt for a field list, which may include ranges in the form +m-n, where m < n and n defaults to the last field index if omitted. + +When called non-interactively, FIELDS is a single field index or a +list of field indices, with ranges specified as (m.n) or (m), and BEG +and END specify the region to process." + ;; (interactive "*P\nr") + (interactive (csv-interactive-args 'multiple)) + (barf-if-buffer-read-only) + ;; Kill the field(s): + (setq csv-killed-fields nil) + (save-excursion + (save-restriction + (narrow-to-region beg end) + (goto-char (point-min)) + (if (or (cdr fields) (consp (car fields))) + (csv-kill-many-columns fields) + (csv-kill-one-column (car fields))))) + (setq csv-killed-fields (nreverse csv-killed-fields))) + +(defmacro csv-kill-one-field (field killed-fields) + "Kill field with index FIELD in current line. +Save killed field by `push'ing onto KILLED-FIELDS. +Assumes point is at beginning of line. +Called by `csv-kill-one-column' and `csv-kill-many-columns'." + `(progn + ;; Move to start of field to kill: + (csv-sort-skip-fields ,field) + ;; Kill to end of field (cf. `kill-region'): + (push (delete-and-extract-region + (point) + (progn (csv-end-of-field) (point))) + ,killed-fields) + (if (eolp) (delete-char -1) ; delete trailing separator at eol + (delete-char 1)))) ; or following separator otherwise + +(defun csv-kill-one-column (field) + "Kill field with index FIELD in all lines in (narrowed) buffer. +Save killed fields in `csv-killed-fields'. +Assumes point is at `point-min'. Called by `csv-kill-fields'. +Ignore blank and comment lines." + (while (not (eobp)) + (or (csv-not-looking-at-record) + (csv-kill-one-field field csv-killed-fields)) + (forward-line))) + +(defun csv-kill-many-columns (fields) + "Kill several fields in all lines in (narrowed) buffer. +FIELDS is an unordered list of field indices. +Save killed fields in increasing index order in `csv-killed-fields'. +Assumes point is at `point-min'. Called by `csv-kill-fields'. +Ignore blank and comment lines." + (if (eolp) (error "First record is empty")) + ;; Convert non-positive to positive field numbers: + (let ((last 1) (f fields)) + (csv-end-of-field) + (while (not (eolp)) + (forward-char) ; skip separator + (csv-end-of-field) + (setq last (1+ last))) ; last = # fields in first record + (while f + (cond ((consp (car f)) + ;; Expand a field range: (m.n) -> m m+1 ... n-1 n. + ;; If n is nil then it defaults to the number of fields. + (let* ((range (car f)) (cdrf (cdr f)) + (m (car range)) (n (cdr range))) + (if (< m 0) (setq m (+ m last 1))) + (if n + (if (< n 0) (setq n (+ n last 1))) + (setq n last)) + (setq range (list n)) + (while (> n m) (push (setq n (1- n)) range)) + (setcar f (car range)) + (setcdr f (cdr range)) + (setcdr (setq f (last range)) cdrf))) + ((zerop (car f)) (setcar f 1)) + ((< (car f) 0) (setcar f (+ f last 1)))) + (setq f (cdr f)))) + (goto-char (point-min)) + ;; Kill from right to avoid miscounting: + (setq fields (sort fields '>)) + (while (not (eobp)) + (or (csv-not-looking-at-record) + (let ((fields fields) killed-fields field) + (while fields + (setq field (car fields) + fields (cdr fields)) + (beginning-of-line) + (csv-kill-one-field field killed-fields)) + (push (mapconcat 'identity killed-fields (car csv-separators)) + csv-killed-fields))) + (forward-line))) + +(defun csv-yank-fields (field beg end) + "Yank fields as the ARGth field of each line in the region. +ARG may be arbitrarily large and records are extended as necessary. +If not set, the region defaults to the CSV records around point\; +if point is not in a CSV record then offer to yank as a new table. +The fields yanked are those last killed by `csv-kill-fields'. +Fields are separated by `csv-separators' and null fields are allowed anywhere. +Field indices increase from 1 on the left or decrease from -1 on the right. +A prefix argument specifies a single field, otherwise prompt for field index. +Ignore blank and comment lines. When called non-interactively, FIELD +is a single field index\; BEG and END specify the region to process." + ;; (interactive "*P\nr") + (interactive (condition-case err + (csv-interactive-args 'single) + (error (list nil nil err)))) + (barf-if-buffer-read-only) + (if (null beg) + (if (y-or-n-p (concat (error-message-string end) + ". Yank as a new table? ")) + (csv-yank-as-new-table) + (error (error-message-string end))) + (if (<= field 0) (setq field (1+ field))) + (save-excursion + (save-restriction + (narrow-to-region beg end) + (goto-char (point-min)) + (let ((fields csv-killed-fields)) + (while (not (eobp)) + (unless (csv-not-looking-at-record) + ;; Yank at start of specified field if possible, + ;; otherwise yank at end of record: + (if (zerop field) + (end-of-line) + (csv-sort-skip-fields field 'yank)) + (and (eolp) (insert (car csv-separators))) + (when fields + (insert (car fields)) + (setq fields (cdr fields))) + (or (eolp) (insert (car csv-separators)))) + (forward-line))))))) + +(defun csv-yank-as-new-table () + "Yank fields as a new table starting at point. +The fields yanked are those last killed by `csv-kill-fields'." + (interactive "*") + (let ((fields csv-killed-fields)) + (while fields + (insert (car fields) ?\n) + (setq fields (cdr fields))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Aligning fields +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun csv-align-fields (hard beg end) + "Align all the fields in the region to form columns. +The alignment style is specified by `csv-align-style'. The number of +spaces specified by `csv-align-fields' appears after each separator. +Use soft alignment done by displaying virtual white space after the +separators unless invoked with an argument, in which case insert real +space characters into the buffer after the separators. +Unalign first (see `csv-unalign-fields'). Ignore blank and comment lines. + +In hard-aligned records, separators become invisible whenever +`buffer-invisibility-spec' is non-nil. In soft-aligned records, make +separators invisible if and only if `buffer-invisibility-spec' is +non-nil when the records are aligned\; this can be changed only by +re-aligning. \(Unaligning always makes separators visible.) + +When called non-interactively, use hard alignment if HARD is non-nil\; +BEG and END specify the region to align." + (interactive (csv-interactive-args)) + (setq end (set-marker (make-marker) end)) + (csv-unalign-fields hard beg end) ; if hard then barfs if buffer read only + (save-excursion + (save-restriction + (narrow-to-region beg end) + (set-marker end nil) + (goto-char (point-min)) + (let (widths) + ;; Construct list of column widths: + (while (not (eobp)) ; for each record... + (or (csv-not-looking-at-record) + (let ((w widths) x) + (setq beg (point)) ; beginning of current field + (while (not (eolp)) + (csv-end-of-field) + (setq x (- (point) beg)) ; field width + (if w + (if (> x (car w)) (setcar w x)) + (setq w (list x) + widths (nconc widths w))) + (or (eolp) (forward-char)) ; skip separator + (setq w (cdr w) + beg (point))))) + (forward-line)) + + ;; Align fields: + (goto-char (point-min)) + (while (not (eobp)) ; for each record... + (or (csv-not-looking-at-record) + (let ((w widths) (padding 0) x) + (setq beg (point)) ; beginning of current field + (while (and w (not (eolp))) + (let ((left-padding 0) (right-padding 0) overlay) + (csv-end-of-field) + (set-marker end (point)) ; end of current field + (setq x (- (point) beg) ; field width + x (- (car w) x)) ; required padding + + ;; beg = beginning of current field + ;; end = (point) = end of current field + + ;; Compute required padding: + (cond + ((eq csv-align-style 'left) + ;; Left align -- pad on the right: + (setq left-padding csv-align-padding + right-padding x)) + ((eq csv-align-style 'right) + ;; Right align -- pad on the left: + (setq left-padding (+ csv-align-padding x))) + ((eq csv-align-style 'auto) + ;; Auto align -- left align text, right align numbers: + (if (string-match "\\`[-+.[:digit:]]+\\'" + (buffer-substring beg (point))) + ;; Right align -- pad on the left: + (setq left-padding (+ csv-align-padding x)) + ;; Left align -- pad on the right: + (setq left-padding csv-align-padding + right-padding x))) + ((eq csv-align-style 'centre) + ;; Centre -- pad on both left and right: + (let ((y (/ x 2))) ; truncated integer quotient + (setq left-padding (+ csv-align-padding y) + right-padding (- x y))))) + + (if hard + ;; Hard alignment... + (progn + (when (> left-padding 0) ; pad on the left + ;; Insert spaces before field: + (if (= beg end) ; null field + (insert (make-string left-padding ?\ )) + (goto-char beg) ; beginning of current field + (insert (make-string left-padding ?\ )) + (goto-char end))) ; end of current field + (unless (eolp) + (if (> right-padding 0) ; pad on the right + ;; Insert spaces after field: + (insert (make-string right-padding ?\ ))) + ;; Make separator (potentially) invisible; + ;; in Emacs 21.3, neighbouring overlays + ;; conflict, so use the following only + ;; with hard alignment: + (overlay-put (make-overlay (point) (1+ (point))) + ;; 'face 'secondary-selection) ; test + 'invisible t) + (forward-char))) ; skip separator + + ;; Soft alignment... + + (if buffer-invisibility-spec ; csv-hide-separators + + ;; Hide separators... + (progn + ;; Merge right-padding from previous field + ;; with left-padding from this field: + (setq padding (+ padding left-padding)) + (when (> padding 0) + (goto-char beg) ; beginning of current field + (if (bolp) + ;; Display spaces before first field + ;; by overlaying first character: + (overlay-put + (make-overlay (point) (1+ (point))) + 'before-string + (make-string padding ?\ )) + ;; Display separator as spaces: + (overlay-put + (make-overlay (1- (point)) (point)) + ;; 'face 'secondary-selection)) ; test + ;; 'display (make-string padding ?\ ))) + ;; Above 'display mangles buffer + ;; horribly if any string is empty! + 'display `(space :width ,padding))) + (goto-char end)) ; end of current field + (unless (eolp) + (setq padding right-padding) + (forward-char))) ; skip separator + + ;; Do not hide separators... + (when (> left-padding 0) ; pad on the left + ;; Display spaces before field: + (setq overlay (make-overlay beg (point))) + (overlay-put overlay 'before-string + (make-string left-padding ?\ ))) + (unless (eolp) + (if (> right-padding 0) ; pad on the right + ;; Display spaces after field: + (overlay-put + (or overlay + (make-overlay beg (point))) + 'after-string (make-string right-padding ?\ ))) + (forward-char))) ; skip separator + + )) + + (setq w (cdr w) + beg (point))))) + (forward-line))))) + (set-marker end nil)) + +(defun csv-unalign-fields (hard beg end) + "Undo soft alignment and optionally remove redundant white space. +Undo soft alignment introduced by `csv-align-fields'. If invoked with +an argument then also remove all spaces and tabs around separators. +Also make all invisible separators visible again. +Ignore blank and comment lines. When called non-interactively, remove +spaces and tabs if HARD non-nil\; BEG and END specify region to unalign." + (interactive (csv-interactive-args)) + ;; Remove any soft alignment: + (mapc 'delete-overlay (overlays-in beg end)) + (when hard + (barf-if-buffer-read-only) + ;; Remove any white-space padding around separators: + (save-excursion + (save-restriction + (narrow-to-region beg end) + (goto-char (point-min)) + (while (not (eobp)) + (or (csv-not-looking-at-record) + (while (not (eolp)) + ;; Delete horizontal white space forward: + ;; (delete-horizontal-space) + ;; This relies on left-to-right argument evaluation; + ;; see info node (elisp) Function Forms. + (delete-region (point) + (+ (point) (skip-chars-forward " \t"))) + (csv-end-of-field) + ;; Delete horizontal white space backward: + ;; (delete-horizontal-space t) + (delete-region (point) + (+ (point) (skip-chars-backward " \t"))) + (or (eolp) (forward-char)))) + (forward-line)))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Transposing rows and columns +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun csv-transpose (beg end) + "Rewrite rows (which may have different lengths) as columns. +Null fields are introduced as necessary within records but are +stripped from the ends of records. Preserve soft alignment. +This function is its own inverse. Ignore blank and comment lines. +When called non-interactively, BEG and END specify region to process." + ;; (interactive "*P\nr") + (interactive (csv-interactive-args 'noarg)) + (barf-if-buffer-read-only) + (save-excursion + (save-restriction + (narrow-to-region beg end) + (goto-char (point-min)) + ;; Delete rows and collect them as a reversed list of lists of + ;; fields, skipping comment and blank lines: + (let ((sep (car csv-separators)) + (align (overlays-in beg end)) + rows columns) + ;; Remove soft alignment if necessary: + (when align + (mapc 'delete-overlay align) + (setq align t)) + (while (not (eobp)) + (if (csv-not-looking-at-record) + ;; Skip blank and comment lines: + (forward-line) + (let ((lep (line-end-position))) + (push + (csv-split-string + (buffer-substring-no-properties (point) lep) + csv-separator-regexp nil t) + rows) + (delete-region (point) lep) + (or (eobp) (delete-char 1))))) + ;; Rows must have monotonic decreasing lengths to be + ;; transposable, so ensure this by padding with null fields. + ;; rows is currently a reversed list of field lists, which + ;; must therefore have monotonic increasing lengths. + (let ((oldlen (length (car rows))) newlen + (r (cdr rows))) + (while r + (setq newlen (length (car r))) + (if (< newlen oldlen) + (nconc (car r) (make-list (- oldlen newlen) nil)) + (setq oldlen newlen)) + (setq r (cdr r)))) + ;; Collect columns as a reversed list of lists of fields: + (while rows + (let (column (r rows) row) + (while r + (setq row (car r)) + ;; Provided it would not be a trailing null field, push + ;; field onto column: + (if (or column (string< "" (car row))) + (push (car row) column)) + ;; Pop field off row: + (setcar r (cdr row)) + ;; If row is now empty then remove it: + (or (car r) (setq rows (cdr rows))) + (setq r (cdr r))) + (push column columns))) + ;; Insert columns into buffer as rows: + (setq columns (nreverse columns)) + (while columns + (insert (mapconcat 'identity (car columns) sep) ?\n) + (setq columns (cdr columns))) + ;; Re-do soft alignment if necessary: + (if align (csv-align-fields nil (point-min) (point-max))))))) + +;; The following generalised version of `split-string' is taken from +;; the development version of WoMan and should probably replace the +;; standard version in subr.el. However, CSV mode (currently) needs +;; only the `allowbeg' option. + +(defun csv-split-string + (string &optional separators subexp allowbeg allowend) + "Splits STRING into substrings where there are matches for SEPARATORS. +Each match for SEPARATORS is a splitting point. +The substrings between the splitting points are made into a list +which is returned. +If SEPARATORS is absent, it defaults to \"[ \\f\\t\\n\\r\\v]+\". +SUBEXP specifies a subexpression of SEPARATORS to be the splitting +point\; it defaults to 0. + +If there is a match for SEPARATORS at the beginning of STRING, we do +not include a null substring for that, unless ALLOWBEG is non-nil. +Likewise, if there is a match at the end of STRING, we do not include +a null substring for that, unless ALLOWEND is non-nil. + +Modifies the match data; use `save-match-data' if necessary." + (or subexp (setq subexp 0)) + (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 subexp)) + (< start (length string))) + (1+ start) start)) + (< (match-beginning subexp) (length string))) + (setq notfirst t) + (or (and (not allowbeg) (eq (match-beginning subexp) 0)) + (and (eq (match-beginning subexp) (match-end subexp)) + (eq (match-beginning subexp) start)) + (push (substring string start (match-beginning subexp)) list)) + (setq start (match-end subexp))) + (or (and (not allowend) (eq start (length string))) + (push (substring string start) list)) + (nreverse list))) + +(provide 'csv-mode) + +;;; csv-mode.el ends here diff --git a/elisp/emacs-goodies-el/ctypes.el b/elisp/emacs-goodies-el/ctypes.el new file mode 100755 index 0000000..0b24122 --- /dev/null +++ b/elisp/emacs-goodies-el/ctypes.el @@ -0,0 +1,1742 @@ +;;; ctypes.el --- Enhanced Font lock support for custom defined types. + +;; Copyright (C) 1997, 1999 Anders Lindgren. + +;; Author: Anders Lindgren +;; Maintainer: Anders Lindgren +;; Version: 1.3.1 +;; Created: 1997-03-16 +;; Date: 1999-06-23 + +;; CTypes 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. + +;; CTypes 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: + +;;{{{ Documentation + +;; Background: +;; +;; As most Emacs users know, Emacs can fontify source code buffers +;; using the `font-lock' package. Most of the time it does a really +;; good job. Unfortunately, the syntax of one of the most widely +;; spread languages, C, makes it difficult to fontify variable +;; declarations. For example, what does the following line mean: +;; +;; hello(foo * bar); +;; +;; 1) A new function `hello' that takes one argument `bar' that is a +;; pointer to a `foo', or; +;; +;; 2) call the function `hello' with the result of `foo' multiplied +;; by `bar'. +;; +;; To answer the question correctly you must know whether `foo' is a +;; type or not. Unfortunately, font-lock has no way of knowing this. + +;; This package: +;; +;; This package can search through source files hunting down typedefs. +;; When found, font-lock is informed and your source code will be even +;; more beautifully colored than before. +;; +;; Each major mode has it's own set of types. It is possible for one +;; major mode to inherit the types of another mode. +;; +;; Currently, this package can parse C and C++ files. (However, since +;; I do not use C++, the probability is high (about 12, on a scale +;; from 1 to 12) that I've missed something). By default C++ inherits +;; the types defined for C mode. + +;; Installation: +;; +;; Place this file in any directory in the emacs load path +;; and add the following line to your init file: +;; (require 'ctypes) +;; +;; Or, if you should prefer to load ctypes only when needed: +;; +;; (defun my-activate-ctypes () (require 'ctypes)) +;; (add-hook 'c-mode-hook 'my-activate-ctypes) +;; (add-hook 'c++-mode-hook 'my-activate-ctypes) +;; +;; Of course, you must also activate font-lock. I also recomend using +;; lazy-lock since adding types requires refontification of all +;; buffers. (Should you use many small buffers, consider lowering +;; `lazy-lock-minimum-size' aswell.) + +;; Defining types: +;; +;; The following commands are available to define and remove types: +;; +;; `ctypes-define-type' Add a type. +;; `ctypes-define-type-in-mode' Add a type to another major mode. +;; `ctypes-buffer' Scan a buffer for types. +;; `ctypes-all-buffer' Scan all buffer for types. +;; `ctypes-tags' Search through all files in a TAGS table. +;; `ctypes-dir' Search a directory hierarchy for files. +;; `ctypes-file' Search in a file for types. +;; `ctypes-remove-type' Remove one type. +;; `ctypes-remove-type-in-mode' Remove one type in another mode. +;; `ctypes-clear-types' Forget all types. +;; `ctypes-clear-types-all-modes' Forget all types in all major modes. + +;; Edit types: +;; +;; If you would like to view or change the types found you can use the +;; function `ctypes-edit'. When done press C-c C-c. Should you like +;; do discard your changes just kill the buffer with C-x k. +;; +;; To edit the types for another major mode use the command +;; `ctypes-edit-types-for-mode'. + +;; Saving types: +;; +;; The commands `ctypes-write-file' and `ctypes-read-file' can be used +;; to save your hard-earned collection of types to a file and to +;; retrieve it later. +;; +;; The default file name is stored in the variable `ctypes-file-name'. +;; +;; Note that only one collection of types are managed. Should you +;; prefer to keep one type file per project, remember to clear the set +;; of known types (using the command `ctypes-clear-types-all-modes') +;; before each new set is generated. + +;; At Load: +;; +;; It is possible to automatically add new types, or read specific +;; type files, when Emacs opens a file. +;; +;; By adding a "Local Variables" section to the end of the file +;; containing the variables `ctypes-add-types-at-load' and/or +;; `ctypes-read-files-at-load' this can be accomplished. +;; +;; For example: +;; +;; /* +;; * Local Variables: +;; * ctypes-add-types-at-load: ("MyType" "YourType") +;; * ctypes-read-files-at-load: (".ctypes") +;; * End: +;; */ + +;; The `Auto Parse' mode: +;; +;; This package can automatically search for new types in all visited +;; files. Activate the minor mode `ctypes-auto-parse-mode' to enable +;; this feature. +;; +;; Add the following line to your startup file to automatically +;; scan all visited files: +;; (ctypes-auto-parse-mode 1) + +;; Example 1: +;; +;; The following setup is for the really lazy person. The keywords +;; collected during one session will be kept for the next, and all +;; visited files will be parsed in the boldly search for new types. +;; I would recomend using this approach only when you are keeping all +;; your types in one file. +;; +;; (require 'ctypes) +;; (setq ctypes-write-types-at-exit t) +;; (ctypes-read-file nil nil t t) +;; (ctypes-auto-parse-mode 1) + +;; Example 2: +;; +;; In this example, ctypes will not be not loaded until either c-mode +;; or c++-mode is activated. When loaded, ctypes will read the type +;; file "~/.ctypes_std_c" (containing, for example, all types defined +;; in the standard C header files). +;; +;; (defun my-c-mode-hook () +;; (require 'ctypes) +;; (turn-on-font-lock)) +;; (add-hook 'c-mode-hook 'my-c-mode-hook) +;; (add-hook 'c++-mode-hook 'my-c-mode-hook) +;; +;; (defun my-ctypes-load-hook () +;; (ctypes-read-file "~/.ctypes_std_c" nil t t)) +;; (add-hook 'ctypes-load-hook 'my-ctypes-load-hook) + +;; Home Page: +;; +;; You can always find the latest version of this package on my Emacs +;; page: +;; +;; http://www.andersl.com/emacs + +;; Reporting bugs: +;; +;; Out of the last ten bugs you found, how many did you report? +;; +;; When reporting a bug, please: +;; +;; * Send a mail the maintainer of the package, or to the author +;; if no maintainer exists. +;; * Include the name of the package in the title of the mail, to +;; simplify for the recipient. +;; * State exactly what you did, what happened, and what you expected +;; to see when you found the bug. +;; * If possible, include an example that activates the bug. +;; * Should you speculate about the cause of the problem, please +;; state explicitly that you are guessing. + +;; CTypes, the true story: +;; +;; Well, brave reader, are you willing to learn what this package +;; really is capable of? +;; +;; Basically, it is a general purpose parsing package. The default +;; settings just happened to specify a parser that looks for C +;; typedefs, and that the default action is to add the types found to +;; font-lock. +;; +;; Be redefining the variable `ctypes-mode-descriptor' you can change +;; the behavior totally. For example, you can use it to search for +;; all occurrences of XX (replace XX with whatever you like) in all +;; files edited in major mode YY (ditto for YY) and to perform ZZ-top +;; whenever a new XX is found. (However, it might be difficult for +;; Emacs to grow a beard). +;; +;; I will, however, in the document string, write "search for types" +;; when I really mean "Call the parser routine as specified by +;; `ctypes-mode-descriptor'". Also, I write "Informing font-lock" +;; whenever I mean "Performing the default action as specified in +;; `ctypes-mode-descriptor'". + +;; The future: +;; +;; Should this package be included in future versions of Emacs almost +;; all of the font-lock code could be removed. Also there will be no +;; need to load font-lock to determine which version of +;; ctypes-mode-descriptor to use. + +;;}}} + +;;; Code: + +;;{{{ Dependencies + +;; The only reason to load font-lock is to determinate the font-lock +;; version we are using. + +(require 'font-lock) + +(eval-when-compile + (require 'cl)) + +;;}}} +;;{{{ Variables + +(defvar ctypes-file-name "~/.ctypes" + "*Default name of file to read types from. + +When `ctypes-read-file' and `ctypes-write-file' are called interactively +the directory part of the file name is ignored.") + + +(defvar ctypes-write-types-at-exit nil + "*When non-nil types are saved to file when Emacs exits. + +When this variable be 'ask, the user is prompted before the +types are saved.") + + +(defvar ctypes-mode-descriptor + (if (boundp 'c-font-lock-extra-types) + ;; A new version of font-lock is used. (As of this writing, + ;; it has not yet been released.) + '((c-mode + (parser ctypes-parse-buffer-c) + (action ctypes-font-lock-set-extra-types + c-font-lock-extra-types)) + (c++-mode + (inherit c-mode) + (parser ctypes-parse-buffer-c++) + (action ctypes-font-lock-set-extra-types + c++-font-lock-extra-types))) + ;; The following can be used together with good old font-lock from + ;; XEmacs and GNU Emacs up to, and including, 19.34. + '((c-mode + (parser ctypes-parse-buffer-c) + (action ctypes-font-lock-add-keywords + ((1 c-font-lock-keywords-2) + (1 c-font-lock-keywords-3) + (2 c-font-lock-keywords-3 t)))) + (c++-mode + (inherit c-mode) + (parser ctypes-parse-buffer-c++) + (action ctypes-font-lock-add-keywords + ((1 c++-font-lock-keywords-2) + (1 c++-font-lock-keywords-3) + (2 c++-font-lock-keywords-3 t)))))) + "*Describe parser, action, and inheritance structure of major mode. + +This structure should be a list where each element should be on +the following form: + ( + (inherit ) + (parser ) + (action function [Optional extra arguments])) + +The function specified in the `action' field is called with at least +one arguments, the major mode. Should the function in the action +field be followed by anything it will be used as additional arguments +when the function is called.") + + +(defvar ctypes-dir-read-file nil + "*Variable determinating which files `ctypes-dir' should read. + +When search for types in a large number of files it is difficult +to determine which files to parse. Should to few be opened, we +can miss some types. The opposite, to open to many be opened, +the parse process could take much longer than needed. + +The default behavior, when `ctypes-dir-read-file' is nil, is to look +at the extension of the files found. Should it match a major mode in +`auto-mode-alist', and the major mode is in `ctypes-mode-descriptor' +we read the file. Obviously, this approach is fast but it is possible +to miss files. + +After the file has been read the real major mode is determined from +the content of the file. This allows you to specify the real mode +using the -*- mode -*- construction. + +Should this variable be t, all non-backup files are read. + +Please see the variable `ctypes-dir-backup-files' for a description on +how backup files are treated. + +To open only a few extra files, bind this variable to a regexp. + +For example, when using the following setting `ctypes-dir' will +open all files ending in `.cplusplus'. + + (setq ctypes-dir-read-file \"\\\\.cplusplus\\\\'\") + +However, the files would still need a -*- C++ -*- header line +to be parsed as C++ files.") + + +(defvar ctypes-dir-backup-files nil + "*Non-nil means that `ctypes-dir' should parse backup files.") + +(defvar ctypes-auto-parse-mode nil + "Non-nil when the minor mode `ctypes-auto-parse-mode' is enabled. + +When this mode is active the `ctypes' package will search for +types in all new buffers loaded. + +To start the mode call the function `ctypes-auto-parse-mode', do not +set this variable explicitly.") + + +(defvar ctypes-auto-parse-mode-hook nil + "*List of functions to run when `ctypes-auto-parse-mode' is activated.") + +(defvar ctypes-load-hook nil + "*List of functions to run when `ctypes' is loaded.") + + +(defvar ctypes-saved-p t + "Nil when types not saved to file.") + + +(defvar ctypes-repetitive-type-regexp + (concat "\\<\\(short\\|int\\|long\\|float\\|" + "double\\|char\\|\\(un\\)?signed\\|const\\)\\>") + "Regexp matching C types and modifiers that can be combined. + +Example: `unsigned char'") + + +;; In some environments the $-sign can be part of C identifiers. +(defvar ctypes-identifier-regexp "[a-zA-Z_][a-zA-Z0-9_$]*" + "Regexp matching C identifiers.") +;; I removed the :-sign, why was it added? (Maybe the regexp should +;; match stuff not ending in colon.) + + +;; Useful during debug and development. +(defvar ctypes-parse-error nil + "(File pos) of latest error, or nil.") + +;;}}} +;;{{{ Commands + +;;;###autoload +(defun ctypes-define-type (type &optional delay-action mode) + "Add a new TYPE to current major mode and inform font-lock. + +When preceded by C-u the display is not updated. + +Return non-nil if the type was not known before." + (interactive + (list + (let* ((default (ctypes-get-type-under-point)) + (prompt (if default + (format "Type: (default %s) " default) + "Type: ")) + (spec (read-string prompt))) + (if (equal spec "") default spec)) + prefix-arg)) + (if (equal type "") + (error "Can't define \"\" as a type")) + (or mode + (setq mode major-mode)) + (and type + (> (length type) 0) + (let ((added (ctypes-add-types mode (list type)))) + (ctypes-perform-action mode added delay-action) + added))) + + +;; Designed for interactive use only. +;;;###autoload +(defun ctypes-define-type-in-mode (type &optional delay-action mode) + "Add TYPE to major mode MODE and inform font-lock. + +When preceded by C-u the display is not updated. + +\(This function is designed for interactive use, please call +`ctypes-define-type' from Lisp programs.)" + (interactive "sType: \nP\nsIn mode: ") + (ctypes-define-type type delay-action (ctypes-string-to-mode mode))) + + +;;;###autoload +(defun ctypes-buffer (&optional buf delay-action mode) + "Search for types in buffer, inform font-lock if any is found. + +When preceded by C-u the action is not performed. + +Return non-nil if new types are found." + (interactive "bSearch for types in buffer: \nP") + (save-excursion + (if buf + (set-buffer buf) + (setq buf (current-buffer))) + (or mode + (setq mode major-mode))) + (let ((added (ctypes-add-types mode (ctypes-parse-buffer buf mode)))) + (ctypes-perform-action mode added delay-action) + added)) + + +;;;###autoload +(defun ctypes-all-buffers (&optional delay-action) + "Search for types in all buffers, inform font-lock about all discoveries. + +When preceded by C-u the display is not updated. + +Return non-nil if new types are found." + (interactive "P") + (save-excursion + (let ((modes '()) + (added nil)) + (dolist (buf (buffer-list)) + (set-buffer buf) + (if (assq major-mode ctypes-mode-descriptor) + (if (not (ctypes-buffer nil t)) + () + (setq added t) + (if (not (memq major-mode modes)) + (setq modes (cons major-mode modes)))))) + (ctypes-perform-action modes added delay-action) + added))) + + +;;;###autoload +(defun ctypes-tags (&optional delay-action) + "Search for types in files in the visited TAGS table. +Should no tags table be visited, the user will be prompted for a new. + +When preceded by C-u the display is not updated. + +Return non-nil if new types are found." + (interactive "P") + (let ((modes (ctypes-tags-parse))) + (ctypes-perform-action modes t delay-action) + (not (null modes)))) + + +;;;###autoload +(defun ctypes-dir (&optional dir delay-action) + "Search for types in files in a directory hierarchy. + +See variable `ctypes-dir-read-file' for a description of which files +are opened during scanning, and how you can change the behavior. + +When preceded by C-u the display is not updated. + +Return non-nil if new types are found." + (interactive "DSearch in directory: \nP") + (if (null dir) + (setq dir default-directory)) + (let ((dirs (list dir)) + (modes '())) + (while dirs + (setq dir (car dirs)) + (setq dirs (cdr dirs)) + (dolist (file (directory-files dir t)) ; Files and dirs + (cond + ((file-accessible-directory-p file) + (if (and (not (string= (file-name-nondirectory file) ".")) + (not (string= (file-name-nondirectory file) ".."))) + (setq dirs (cons file dirs)))) + ((file-readable-p file) + (if (or ctypes-dir-backup-files + (not (backup-file-name-p file))) + (if (or (eq ctypes-dir-read-file t) + (and (stringp ctypes-dir-read-file) + (string-match ctypes-dir-read-file file)) + (assq (ctypes-get-mode-from-file-name file) + ctypes-mode-descriptor)) + (let ((mode (ctypes-file file t))) + (if mode + (setq modes (cons mode modes)))))))))) + (and modes + (ctypes-perform-action modes t delay-action)))) + + +;;;###autoload +(defun ctypes-file (file &optional delay-action) + "Search for types in file FILE. +Should FILE not be loaded it is read into a temporary buffer. + +Return mode of file, if new types was found." + (interactive "fSearch in file: \nP") + ;; (message "Scanning %s..." file) ; Debug + (let ((added nil) + mode) + (save-excursion + (cond ((get-file-buffer file) + (set-buffer (find-file-noselect file t)) + (setq mode major-mode) + (setq added (ctypes-buffer nil t mode))) + (t + (set-buffer (get-buffer-create " *ctypes-file*")) + (kill-all-local-variables) + (erase-buffer) + (insert-file-contents file nil) + (let ((buffer-file-name file)) + (setq mode (ctypes-get-mode)) + (if mode + (setq added (ctypes-buffer nil delay-action mode)))) + (kill-buffer (current-buffer))))) + ;; (message "Scanning %s...done" file) ; Debug + (if mode + (ctypes-perform-action mode added delay-action)) + (and added mode))) + + +(defun ctypes-remove-type (type &optional delay-action mode) + "Remove TYPE from the set of known types for major mode of current buffer. + +When preceded by C-u the display is not updated. + +Return non-nil if type is removed." + (interactive + (list + (let* ((default (ctypes-get-type-under-point)) + (prompt (if default + (format "Type: (default %s) " default) + "Type: ")) + (spec (read-string prompt))) + (if (equal spec "") default spec)) + prefix-arg)) + (or mode + (setq mode major-mode)) + (let ((removed (ctypes-delete-types mode (list type)))) + (ctypes-perform-action mode removed delay-action) + removed)) + + +;; Designed for interactive use only. +(defun ctypes-remove-type-in-mode (type &optional delay-action mode) + "Remove TYPE from the set of known types for major mode MODE. + +MODE can either be a symbol (e.g. c++-mode), or a string (e.g. \"C++\"). + +When preceded by C-u the display is not updated. + +Return non-nil if type is removed." + (interactive "sType: \nP\nsIn mode: ") + (ctypes-remove-type type delay-action (ctypes-string-to-mode mode))) + + +(defun ctypes-clear-types (&optional delay-action) + "Clear all known types for major mode of current buffer. + +When preceded by C-u the display is not updated. + +Return non-nil if any types actually were removed." + (interactive "P") + (setq ctypes-parse-error nil) ; Debug + (let ((removed (ctypes-set-types major-mode '()))) + (ctypes-perform-action major-mode removed delay-action) + removed)) + + +(defun ctypes-clear-types-all-modes (&optional delay-action) + "Clear all types for all modes. + +When preceded by C-u the display is not updated. + +Return non-nil if any types actually were removed." + (interactive "P") + (setq ctypes-parse-error nil) ; Debug + (let ((modes '())) + (dolist (desc ctypes-mode-descriptor) + (if (ctypes-set-types (car desc) '()) + (setq modes (cons (car desc) modes)))) + (if modes + (ctypes-perform-action modes t t)) + (or delay-action + (ctypes-perform-delayed-action)) + (not (null modes)))) + + +(defun ctypes-update () + "Make sure no delayed action is pending for types of major mode. + +Since it can take some time to re-fontify all buffers after every +command it is possible to inhibit redisplay by preceding the command +by C-u. This command can be used to refontify all buffers after a +number of such commands." + (ctypes-perform-action major-mode nil t)) + + +(defun ctypes-update-all-modes () + "Make sure no delayed action is pending for any major mode. + +Since it can take some time to re-fontify all buffers after every +command it is possible to inhibit redisplay by preceding the command +by C-u. This command can be used to refontify all buffers after a +number of such commands." + (ctypes-perform-delayed-action)) + +;;}}} +;;{{{ Minor mode: ctypes-auto-parse-mode + +;;;###autoload +(defun ctypes-auto-parse-mode (&optional arg) + "Toggle CTypes auto parse mode; search all new buffers for types. +With arg, turn types Auto Mode on if and only if arg is positive. + +This a global minor mode, it does not have a private keymap, nor does +it add itself to the mode line. + +Place the following in your startup file to enable this feature in +future sessions: + + (require 'ctypes) + (ctypes-auto-parse-mode 1) + +When activated, the functions in the hook `ctypes-auto-parse-mode-hook' +is called with no args." + (interactive "P") + (setq ctypes-auto-parse-mode + (if (null arg) + (not ctypes-auto-parse-mode) + (> (prefix-numeric-value arg) 0))) + (if ctypes-auto-parse-mode + (run-hooks 'ctypes-auto-parse-mode-hook))) + +;;}}} +;;{{{ Find-file hook + +(defvar ctypes-add-types-at-load '() + "List of types to be added when file is opened. + +This variable is designed to be used in a \"Local Variables\" section +at the end of source files.") + + +(defvar ctypes-read-files-at-load '() + "CTypes files to be read when file is opened. + +This variable could either be the name of a type file, or a list of +type files. + +This variable is designed to be used in a \"Local Variables\" section +at the end of source files. Should this variable not be defined in a +Local Variables section, the global value is used. By setting this +varible to, for examle, \".ctypes\" Emacs will try to read a type file +named \".ctypes\" in every directory it opens files from.") + + +(defun ctypes-find-file-hook () + "Add types specified in file local variables. + +This function is called every time a file is opened. It looks at two +variables `ctypes-add-types-at-load' and `ctypes-read-files-at-load'. +They are designed to be added to the \"Local Variables:\" section at +the end of source files. The idea is to automatically set or load +the types needed when a file is opened. + +When `ctypes-auto-parse-mode' is active this function will parse +the content of the buffer looking for types." + (let ((added nil)) + (if (and ctypes-add-types-at-load + (ctypes-add-types major-mode ctypes-add-types-at-load)) + (setq added t)) + (dolist (file (or (and (stringp ctypes-read-files-at-load) + (list ctypes-read-files-at-load)) + ctypes-read-files-at-load)) + (if (and (stringp file) + (ctypes-read-file file nil t)) + (setq added t))) + (if ctypes-auto-parse-mode + (ctypes-buffer nil t)) + (ctypes-perform-action major-mode added nil))) + +;;}}} +;;{{{ Read and write + +;;;###autoload +(defun ctypes-read-file (&optional file delay-action no-error quietly) + "Load types previously saved with `ctypes-write-file'. +The name of the file is given by the optional argument FILE. +Should no file name be given the value of the variable `ctypes-file-name' +is used. + +Please note that the types read will be added to the current types. + +When preceded by C-u the display is not updated. + +The third argument, NO-ERROR, determines whether or not we should +raise an error if there should be any problem loading the file. + +Should the fourth argument, QUIETLY, be non-nil no messages are +generated when the file is loaded. + +Return non-nil if new types are found." + (interactive + (list + (ctypes-interactive-read-file-name "Read types from file: ") + current-prefix-arg)) + (setq file (ctypes-gen-file-name file)) + (let ((current-types-alist '())) + (dolist (desc ctypes-mode-descriptor) + (let ((mode (car desc))) + (setq current-types-alist + (cons (cons mode (ctypes-get-types mode)) + current-types-alist)))) + (load file no-error quietly) + (setq ctypes-saved-p t) + ;; Add the original types, and update wherever needed. + (let ((modes '())) ; Updated modes + (dolist (pair current-types-alist) + (if (not (ctypes-subset + (ctypes-get-types (car pair)) + (cdr pair))) + ;; New types was defined for this mode. + (setq modes (cons (car pair) modes))) + (ctypes-add-types (car pair) (cdr pair))) + (if modes + (ctypes-perform-action modes t delay-action)) + modes))) + + +(defun ctypes-write-file (&optional file) + "Write all types to a file. +The file is readable by the function `ctypes-read-file'. + +Should no file name be given, the value of the variable `ctypes-file-name' +is used." + (interactive + (list + (ctypes-interactive-read-file-name "Write types file: "))) + (setq file (ctypes-gen-file-name file)) + (save-excursion + (set-buffer (get-buffer-create " *ctypes-write-file*")) + (erase-buffer) + (insert ";; This file has been automatically generated by the ") + (insert "Emacs package `ctypes'.\n") + (insert ";; Please use the `ctypes-read-file' to load it.\n\n") + (dolist (desc ctypes-mode-descriptor) + (insert "(ctypes-set-types '") + (insert (prin1-to-string (car desc))) + (insert " '") + (insert (prin1-to-string (ctypes-get-types (car desc)))) + (insert ")\n\n")) + (write-region 1 (point-max) file) + (erase-buffer)) + (setq ctypes-saved-p t)) + + +(defun ctypes-kill-emacs-hook (&optional file) + "Save the types to FILE, when needed. + +Should the variable `ctypes-write-types-at-exit' be nil this function +does nothing. Should it be the atom `ask' the user is prompted before +the types are saved. + +When FILE is nil, the variable `ctypes-file-name' is used." + (interactive) + (setq file (ctypes-gen-file-name file)) + (and (not ctypes-saved-p) + ctypes-write-types-at-exit + (or (not (eq ctypes-write-types-at-exit 'ask)) + (y-or-n-p (format "Save types in `%s'? " file))) + (ctypes-write-file file))) + + +(defun ctypes-interactive-read-file-name (prompt) + "Command argument reader, suitable for `interactive'." + (read-file-name prompt + default-directory + (file-name-nondirectory ctypes-file-name))) + + +(defun ctypes-gen-file-name (file) + "Generate the file name to used to read and write the types. + +Should FILE be nil or an empty string, the content of the +variable `ctypes-file-name' is used. Should FILE be a directory +name, the file part of `ctypes-file-name' is added to FILE." + (cond ((or (null file) (string= file "")) + ctypes-file-name) + ((file-directory-p file) + ;; I really would like a system-independent + ;; add-file-to-directory function... + (let* ((base (file-name-nondirectory ctypes-file-name)) + (first-try (concat file base))) + (if (string= base (file-name-nondirectory first-try)) + first-try + (concat file "/" base)))) + (t file))) + +;;}}} +;;{{{ Edit + +(defvar ctypes-edit-map nil + "Keymap used in ctypes-edit mode.") +(if ctypes-edit-map + nil + (setq ctypes-edit-map (make-sparse-keymap)) + (define-key ctypes-edit-map "\C-c\C-c" 'ctypes-edit-update-and-exit) + (define-key ctypes-edit-map "\C-c\C-x" 'ctypes-edit-update) + (define-key ctypes-edit-map "\C-c\C-w" 'ctypes-edit-write-file)) + + +(defvar ctypes-edit-types-for-mode nil + "Major mode that the edited types belong to. + +This is a buffer-local variable used by `ctypes-edit-mode'.") + + +(defun ctypes-edit (&optional mode) + "Create buffer for editing types in current major mode. + +The buffer can be edited using normal Emacs editing commands. When +done, press C-c C-c to use the edited version of the types. + +See also the function `ctypes-edit-types-in-mode'." + (interactive) + (or mode + (setq mode major-mode)) + (let ((buf (get-buffer-create "*ctypes-edit*")) + (lst (ctypes-get-types mode))) + (if (not (assq mode ctypes-mode-descriptor)) + (error "Can't edit types for %s %s" + mode "(see variable `ctypes-mode-descriptor').")) + (switch-to-buffer buf) + (set (make-local-variable 'ctypes-edit-types-for-mode) mode) + (erase-buffer) + (insert (format ";; Types for %s.\n" mode)) + (insert ";;\n") + (insert ";; Press `C-c C-c' to install types.\n") + (insert ";; `C-x k' to discard changes.\n\n") + (save-excursion + (dolist (type lst) + (insert type) + (insert "\n"))) + (set-buffer-modified-p nil) + (ctypes-edit-mode))) + + +;; This function is designed for interactive use only. +(defun ctypes-edit-types-in-mode (mode) + "Create buffer for editing types in major mode MODE. + +The buffer can be edited using normal Emacs editing commands. When +done, press C-c C-c to install the edited version of the types." + (interactive "sMode: ") + (ctypes-edit (ctypes-string-to-mode mode))) + + +(defun ctypes-edit-mode () + "Major mode for editing types. +\\{ctypes-edit-map}" + (interactive) + (setq major-mode 'ctypes-edit-mode) + (setq mode-name "CTypes-Edit") + (use-local-map ctypes-edit-map)) + + +(defun ctypes-edit-update (&optional delay-action) + "Install the types currently found in the *ctypes-edit* buffer. + +When preceded by C-u the display is not updated. + +Return non-nil if the set of types has been changed." + (interactive "P") + (if (not (eq major-mode 'ctypes-edit-mode)) + (error "Command only meaningful in the *ctypes-edit* buffer")) + (let* ((lst (ctypes-edit-get-types)) + (added (ctypes-set-types ctypes-edit-types-for-mode lst))) + (ctypes-perform-action ctypes-edit-types-for-mode added delay-action) + added)) + + +(defun ctypes-edit-update-and-exit (&optional inhibit-redraw) + "Install the types and close the edit buffer. + +When preceded by C-u the display is not updated. + +Return non-nil if the set of types has been changed." + (interactive "P") + (prog1 + (ctypes-edit-update inhibit-redraw) + (set-buffer-modified-p nil) + (kill-buffer (current-buffer)))) + + +(defun ctypes-edit-write-file (file &optional inhibit-redraw) + (interactive + (list + (ctypes-interactive-read-file-name "Write types file: ") + current-prefix-arg)) + (ctypes-edit-update inhibit-redraw) + (ctypes-write-file file) + (set-buffer-modified-p nil)) + + +(defun ctypes-edit-get-types () + "Return, as a list of strings, the types in an `ctypes-edit' buffer. +The types could even be regexps." + (save-excursion + (let ((lst '())) + (goto-char (point-min)) + (while (< (point) (point-max)) + (skip-chars-forward " \t") + (if (not (eq (following-char) ?\;)) + (let ((p (point))) + (end-of-line) + (skip-chars-backward " \t") + (if (not (equal p (point))) + (setq lst (cons (buffer-substring-no-properties + p (point)) + lst))))) + (forward-line)) + (reverse lst)))) + +;;}}} +;;{{{ Types alist primitives + +;; This section contains functions that handle the actual set of types +;; found in each mode. + +(defvar ctypes-types-alist '() + "AList containing types for various modes. + +The car of each element is the major mode (a symbol) and the cdr is a +list containing the types (strings).") + + +(defun ctypes-get-types (mode) + "Return types for major mode MODE." + (let ((pair (assq mode ctypes-types-alist))) + (if pair + (cdr pair) + '()))) + + +(defun ctypes-set-types (mode type-list) + "Replace current set of types for major mode MODE. + +Return non-nil if the new set of types is different from the original set." + (let ((tmp '()) + (done nil) + added) + (while (not done) + (cond ((null ctypes-types-alist) + (setq added (not (null type-list))) + (setq done t)) + ((eq mode (car (car ctypes-types-alist))) + (setq added (not (ctypes-equal type-list + (cdr (car ctypes-types-alist))))) + (setq ctypes-types-alist (cdr ctypes-types-alist)) + (setq done t)) + (t + (setq tmp (cons (car ctypes-types-alist) tmp)) + (setq ctypes-types-alist (cdr ctypes-types-alist))))) + (if type-list + (setq ctypes-types-alist (cons (cons mode type-list) + ctypes-types-alist))) + (setq ctypes-types-alist (append (reverse tmp) ctypes-types-alist)) + (if added + (setq ctypes-saved-p nil)) + added)) + + +(defun ctypes-add-types (mode type-list) + "Add types in TYPE-LIST to major mode MODE. +Return non-nil if at least one new type was added." + (let ((current-types (ctypes-get-types mode)) + (added nil)) + (dolist (type (reverse type-list)) ; Try to keep original order. + (if (member type current-types) + () + (setq current-types (cons type current-types)) + (setq added t))) + (if added + (ctypes-set-types mode current-types)) + added)) + + +(defun ctypes-collect-types (mode) + "Return types for MODE, including inherited types." + (let ((modes (ctypes-collect-super-modes mode)) + (types '())) + (while modes + (setq types (ctypes-union-types types (ctypes-get-types (car modes)))) + (setq modes (cdr modes))) + types)) + + +(defun ctypes-collect-super-modes (mode) + "Return a list of all super modes to MODE. + +Note that we have not superimposed any type of structure on the +inheritance graph. For example, it can contain cycles! + +MODE is trivially a super mode to itself." + (let ((super-modes '()) + (must-check (list mode))) + (while must-check + (setq mode (car must-check)) + (setq must-check (cdr must-check)) + (let ((desc (assq mode ctypes-mode-descriptor))) + (cond (desc + (setq desc (cdr desc)) ;; Remove the mode name. + (while desc + (if (eq (nth 0 (car desc)) 'inherit) + (let ((other-mode (nth 1 (car desc)))) + (if (and (not (eq other-mode mode)) + (not (memq other-mode super-modes)) + (not (memq other-mode must-check))) + (setq must-check (cons other-mode must-check))))) + (setq desc (cdr desc))))) + (setq super-modes (cons mode super-modes)))) + super-modes)) + + +(defun ctypes-collect-sub-modes (mode) + "Return a list of all modes that inherits MODE." + (let ((sub-modes '()) + (alist ctypes-mode-descriptor)) + (while alist + (if (memq mode (ctypes-collect-super-modes (car (car alist)))) + (setq sub-modes (cons (car (car alist)) sub-modes))) + (setq alist (cdr alist))) + sub-modes)) + + +(defun ctypes-delete-types (mode type-list) + "Removes types in TYPE-LIST. +Return non-nil if any type was removed." + (let ((current-types (ctypes-get-types mode)) + (removed nil) + (new-list '())) + (while current-types + (if (member (car current-types) type-list) + (setq removed t) + (setq new-list (cons (car current-types) new-list))) + (setq current-types (cdr current-types))) + (if removed + (ctypes-set-types mode (reverse new-list))) + removed)) + + +;; Type-list primitives. + +(defun ctypes-equal (type-list1 type-list2) + "Non-nil if the lists contain the same types. +Note that the elements need not come in the same order in the two lists." + (and (ctypes-subset type-list1 type-list2) + (ctypes-subset type-list2 type-list1))) + + +(defun ctypes-subset (type-list1 type-list2) + "Non-nil if type-list1 is included in type-list2." + (let ((included t)) + (while (and included type-list1) + (if (not (member (car type-list1) type-list2)) + (setq included nil)) + (setq type-list1 (cdr type-list1))) + included)) + + +(defun ctypes-union-types (type-list1 type-list2) + "Return the union of the two type lists." + (setq type-list1 (reverse type-list1)) ; Try to maintain original order + (while type-list1 + (if (not (member (car type-list1) type-list2)) + (setq type-list2 (cons (car type-list1) type-list2))) + (setq type-list1 (cdr type-list1))) + type-list2) + +;;}}} +;;{{{ Perform Action + +(defvar ctypes-delayed-action-list '() + "List of major modes whose action has been delayed. + +Normally, this means that the user are executing a number of `ctypes' +and wants to wait to perform the display update until after the last +command. + +The actions are performed the next time the function +`ctypes-perform-action' is called with nil as it's DELAY-ACTION +argument, or when `ctypes-perform-delayed-action' is called.") + + +(defun ctypes-perform-action (modes changed-p delay-action) + "Perform action for all modes in MODES. + +MODES can a mode or a list of modes. + +The action is performed immediately for major modes in MODES, and for +major modes that inherits types from modes in MODES, when +`delay-action' is nil, and either changed-p is non-nil or the modes +previously have been marked for delayed action. + +Should DELAY-ACTION be non-nil, the actions are not performed +and the modes are marked for delayed action." + (if (not (listp modes)) + (setq modes (list modes))) + (cond (delay-action + ;; Mark all modes for delayed action. + (if changed-p + (while modes + (if (not (memq (car modes) ctypes-delayed-action-list)) + (setq ctypes-delayed-action-list + (cons (car modes) ctypes-delayed-action-list))) + (setq modes (cdr modes))))) + (t + ;; Unless a mode has been changed or has been aschedules for + ;; delayed action no action should be performed. + (if (not changed-p) + (let ((new-modes '())) + (while modes + (if (memq (car modes) ctypes-delayed-action-list) + (setq new-modes (cons (car modes) new-modes))) + (setq modes (cdr modes))) + (setq modes new-modes))) + ;; Update all modes that inherits types. + (let ((sub-modes '())) + (while modes + (let ((tmp (ctypes-collect-sub-modes (car modes)))) + (while tmp + (if (not (memq (car tmp) sub-modes)) + (setq sub-modes (cons (car tmp) sub-modes))) + (setq tmp (cdr tmp)))) + (setq modes (cdr modes))) + (setq modes sub-modes)) + ;; Remove all modes from the delayed action list: + (let ((new-modes modes) + (dlist (copy-sequence ctypes-delayed-action-list))) + ;; We make a copy of `ctypes-delayed-action-list' since we + ;; don't want to destructively a list that someone else + ;; might be using. A concrete example is when + ;; `ctypes-perform-delayed-action' is used; the variable + ;; `modes' is also bound to `ctypes-delayed-action-list'! + (while new-modes + (setq dlist (delq (car new-modes) dlist)) + (setq new-modes (cdr new-modes))) + (setq ctypes-delayed-action-list dlist)) + ;; Finally, perform the action. + (while modes + (let ((desc (assq (car modes) ctypes-mode-descriptor))) + (cond (desc + (setq desc (cdr desc)) ; Skip mode name + (while desc + (if (eq (nth 0 (car desc)) 'action) + (apply (nth 1 (car desc)) + (car modes) + (nthcdr 2 (car desc)))) + (setq desc (cdr desc)))))) + (setq modes (cdr modes)))))) + + +(defun ctypes-perform-delayed-action () + "Perform the action (normally update the display)" + (ctypes-perform-action ctypes-delayed-action-list nil nil)) + +;;}}} +;;{{{ The parser + +(defun ctypes-parse-buffer (&optional buffer mode filename) + "Parse BUFFER for types assuming the major mode MODE. + +Note: You can not assume the the buffer actually is in mode MODE. + +Note 2: The file name is only used for debugging." + (save-excursion + (if buffer + (set-buffer buffer)) + (or mode + (setq mode major-mode)) + (save-restriction + (widen) + (goto-char (point-min)) + (let ((desc (assq mode ctypes-mode-descriptor))) + (if desc + (let ((parser (assq 'parser desc))) + (if (null parser) + (error "No parser specified")) + (funcall (nth 1 parser) filename))))))) + + +(defun ctypes-parse-buffer-c (&optional filename) + "Return list of types found in current buffer." + (let ((orig-syntax-table (syntax-table))) + (require 'cc-mode) + (set-syntax-table c-mode-syntax-table) + (set (make-local-variable 'parse-sexp-ignore-comments) t) + (unwind-protect + (let ((lst '())) + (while (re-search-forward "^typedef\\>" nil t) + (condition-case () + (setq lst (append (ctypes-parse-typedef) lst)) + (error + (setq ctypes-parse-error + (list (or filename (buffer-file-name)) (point)))))) + lst) + (set-syntax-table orig-syntax-table)))) + + +(defun ctypes-parse-buffer-c++ (&optional filename) + "Return list of C++ types found in current buffer." + (let ((orig-syntax-table (syntax-table))) + (require 'cc-mode) + (set-syntax-table c-mode-syntax-table) + (set (make-local-variable 'parse-sexp-ignore-comments) t) + (unwind-protect + (let ((lst '())) + (while (re-search-forward + "^\\(\\(typedef\\)\\|class\\|struct\\|enum\\)\\>" nil t) + (condition-case () + (if (match-beginning 2) + (setq lst (append (ctypes-parse-typedef) lst)) + (setq lst (cons (ctypes-parse-class) lst))) + (error + (setq ctypes-parse-error + (list (or filename (buffer-file-name)) (point)))))) + lst) + (set-syntax-table orig-syntax-table)))) + + +;; I'm not 100% convinced that I haven't oversimplified anything. +(defun ctypes-parse-typedef () + "Return the newly defined type in a typedef declaration. +Assume that the point is positioned directly after the `typedef'." + (ctypes-skip-blank) + ;; `const' can precede everything, including a `struct'. + (cond ((looking-at "\\") + (goto-char (match-end 0)) + (ctypes-skip-blank))) + ;; Skip past the basic type. + (cond ((looking-at ctypes-repetitive-type-regexp) + (goto-char (match-end 0)) + (ctypes-skip-blank) + (while (looking-at ctypes-repetitive-type-regexp) + (goto-char (match-end 0)) + (ctypes-skip-blank))) + ((looking-at "\\<\\(struct\\|union\\|enum\\)\\>") + (goto-char (match-end 0)) + (ctypes-skip-blank) + (if (looking-at ctypes-identifier-regexp) + (goto-char (match-end 0))) + (ctypes-skip-blank) + (if (eq (following-char) ?{) + (forward-sexp 1))) + ((eq (following-char) ?\() + ;; The basic type is complex, skip it. + (forward-sexp 1)) + ((looking-at ctypes-identifier-regexp) + ;; Another typedefed type? + (goto-char (match-end 0))) + (t + (error "Can't parse typedef statement"))) + (ctypes-skip-blank) + (while (memq (following-char) '(?& ?<)) + (cond ((eq (following-char) ?<) + ;; C++ template + (skip-chars-forward "^>") + (forward-char)) + ((eq (following-char) ?&) + ;; C++ Reference type + (forward-char))) + (ctypes-skip-blank)) + ;; Step into the type to find the name. Save the start position + ;; so we can pass over pairs of parentheses to find the next name. + (let ((types '())) + (while + (let (start) + (ctypes-skip-blank) + (setq start (point)) + (while (memq (following-char) '(?* ?\()) + (forward-char 1) + (ctypes-skip-blank)) + (cond ((looking-at ctypes-identifier-regexp) + (setq types (cons + (regexp-quote + (buffer-substring-no-properties + (match-beginning 0) (match-end 0))) + types))) + (t + (error "Parse error"))) + (goto-char start) + (while (looking-at + (concat "\\([*(&[]\\|\\(" ctypes-identifier-regexp + "\\)\\)")) + (cond ((match-beginning 2) + (goto-char (match-end 0))) + ((memq (following-char) '(?\( ?\[)) + (forward-sexp 1)) + (t + (forward-char))) + (ctypes-skip-blank)) + ;; Comment out this for a more liberal parser. + (if (not (memq (following-char) '(?, ?\;))) + (error "Parse Error")) + (eq (following-char) ?,)) + ;; I know it isn't much, but this is the body of the while-expression. + (forward-char)) + types)) + + +;; Probably wrong, since I don't speak C++. +(defun ctypes-parse-class () + (ctypes-skip-blank) + (if (looking-at ctypes-identifier-regexp) + (regexp-quote + (buffer-substring-no-properties (match-beginning 0) (match-end 0))) + (error "Not a valid class (I think)"))) + + +(defun ctypes-skip-blank (&optional lim) + (or lim (setq lim (point-max))) + (let ((stop nil)) + (while (and (not stop) (< (point) lim)) + (cond ((looking-at "//") + (skip-chars-forward "^\n" lim)) + ((looking-at "/\\*") + ;; A comment; there must be a better way to skip this. + (if (search-forward "*/" nil t) + (goto-char (match-end 0)) + (setq stop t))) + ((= (following-char) ?\n) + (skip-chars-forward "\n" lim)) + ((looking-at "^#") + (while (progn + (end-of-line) + (eq (preceding-char) ?\\)) + (forward-line)) + (forward-line)) + ((looking-at "\\s ") + (if (re-search-forward "\\S " lim 'move) + (forward-char -1))) + (t + (setq stop t)))) + stop)) + +;;}}} +;;{{{ TAGS + +(defun ctypes-tags-parse () + "Parse files in current TAGS table. Does not perform redraw. + +Return list of updated modes. + +See the function `ctypes-tags'." + (save-excursion + (let ((first-time t) + (modes '()) + new) + (while (condition-case () + (progn + (setq new (next-file first-time t)) + t) + (error nil)) + (setq first-time nil) + (let* ((buffer-file-name new) + (mode (or (and new (ctypes-get-mode)) major-mode))) + (if (assq mode ctypes-mode-descriptor) + (if (ctypes-buffer nil t mode) + (if (not (memq mode modes)) + (setq modes (cons mode modes))))))) + modes))) + +;;}}} +;;{{{ Major mode functions + +;; Sigh, all this code already exists in Emacs! However, In addition +;; to finding the mode that code also _activates_ the modes. Clearly, +;; this is not a Good Thing since we only would like to parse the +;; content and get on with it. +;; +;; Also, I had to chop up the original function `set-auto-mode' into +;; three parts since I needed to get access to the `auto-mode-alist' +;; code in isolation. + +(defun ctypes-get-mode (&optional buf) + "Return mode the buffer ought to have." + (or buf + (setq buf (current-buffer))) + (save-excursion + (set-buffer buf) + (or (let ((modes (ctypes-get-auto-mode buf))) + (cond ((eq modes '()) + nil) + ((= (length modes) 1) + (car modes)) + (t + ;; Several modes was specified using the -*- mode: + ;; foo; mode: bar; -*- construction. We have no idea + ;; which are major and which are minor modes so we + ;; pick the last one that is a member of + ;; `ctypes-mode-descriptor'. + (let ((done nil)) + (setq modes (reverse modes)) + (while (and (not done) (> (length modes) 1)) + (if (assq (car modes) ctypes-mode-descriptor) + (setq done t) + (setq modes (cdr modes)))) + (car modes))))) + (ctypes-get-mode-from-file-name) + (ctypes-get-mode-interpreter)))) + + +(defun ctypes-get-auto-mode (buf) + "Return list of modes specified in a -*- ... -*- header line." + (let (beg end modes) + (save-excursion + (goto-char (point-min)) + (skip-chars-forward " \t\n") + (and enable-local-variables + ;; Don't look for -*- if this file name matches any + ;; of the regexps in inhibit-first-line-modes-regexps. + (let ((temp inhibit-first-line-modes-regexps) + (name (if buffer-file-name + (file-name-sans-versions buffer-file-name) + (buffer-name)))) + (while (let ((sufs inhibit-first-line-modes-suffixes)) + (while (and sufs (not (string-match (car sufs) name))) + (setq sufs (cdr sufs))) + sufs) + (setq name (substring name 0 (match-beginning 0)))) + (while (and temp + (not (string-match (car temp) name))) + (setq temp (cdr temp))) + (not temp)) + (search-forward "-*-" (save-excursion + ;; If the file begins with "#!" + ;; (exec interpreter magic), look + ;; for mode frobs in the first two + ;; lines. You cannot necessarily + ;; put them in the first line of + ;; such a file without screwing up + ;; the interpreter invocation. + (end-of-line (and (looking-at "^#!") 2)) + (point)) t) + (progn + (skip-chars-forward " \t") + (setq beg (point)) + (search-forward "-*-" + (save-excursion (end-of-line) (point)) + t)) + (progn + (forward-char -3) + (skip-chars-backward " \t") + (setq end (point)) + (goto-char beg) + (if (save-excursion (search-forward ":" end t)) + ;; Find all specifications for the `mode:' variable + ;; and execute them left to right. + (while (let ((case-fold-search t)) + (or (and (looking-at "mode:") + (goto-char (match-end 0))) + (re-search-forward "[ \t;]mode:" end t))) + (skip-chars-forward " \t") + (setq beg (point)) + (if (search-forward ";" end t) + (forward-char -1) + (goto-char end)) + (skip-chars-backward " \t") + (setq modes + (cons (intern + (concat + (downcase + (buffer-substring beg (point))) "-mode")) + modes))) + ;; Simple -*-MODE-*- case. + (setq modes + (cons (intern + (concat (downcase (buffer-substring beg end)) + "-mode")) + modes)))))) + (reverse modes))) + + +(defun ctypes-get-mode-from-file-name (&optional name) + "Suggest major mode for file named NAME, no nil." + (or name + (setq name buffer-file-name)) + ;; Code taken from `set-auto-mode'. + (let ((keep-going t) + (mode nil)) + (setq name (file-name-sans-versions name)) + (while keep-going + (setq keep-going nil) + (let ((alist auto-mode-alist)) + ;; Find first matching alist entry. + (let ((case-fold-search (memq system-type '(vax-vms windows-nt)))) + (while (and (not mode) alist) + (if (string-match (car (car alist)) name) + (if (and (consp (cdr (car alist))) + (nth 2 (car alist))) + (setq mode (car (cdr (car alist))) + name (substring name 0 (match-beginning 0)) + keep-going t) + (setq mode (cdr (car alist)) + keep-going nil))) + (setq alist (cdr alist)))))) + mode)) + + +(defun ctypes-get-mode-interpreter () + "Get major mode based on #! sequence at head of buffer." + (save-excursion + (goto-char (point-min)) + (and (looking-at "#![ \t]?\\([^ \t\n]*/bin/env[ \t]\\)?\\([^ \t\n]+\\)") + (cdr-safe (assoc (file-name-nondirectory + (buffer-substring (match-beginning 2) + (match-end 2))) + interpreter-mode-alist))))) + +;;}}} +;;{{{ Misc + +(or (fboundp 'regexp-opt-depth) + (defun regexp-opt-depth (keyword) + "Return the depth of KEYWORD regexp. +This means the number of parenthesized expressions." + (let ((count 0) start) + (while (string-match "\\\\(" keyword start) + (setq start (match-end 0) count (1+ count))) + count))) + + +(defun ctypes-string-to-mode (mode) + "Convert a mode name, entered by the user, to a mode symbol. + +Example: + (ctypes-string-to-mode \"C++\") => c++-mode" + (if (stringp mode) + (if (string-match "-mode$" mode) + (setq mode (intern mode)) + (setq mode (intern (concat mode "-mode"))))) + ;; Make sure "C++" works. + (if (not (assq mode ctypes-mode-descriptor)) + (let ((lowercase-mode (intern (downcase (symbol-name mode))))) + (if (assq lowercase-mode ctypes-mode-descriptor) + (setq mode lowercase-mode)))) + mode) + + +(defun ctypes-get-type-under-point () + (save-excursion + (if (eq (char-syntax (following-char)) ? ) + (skip-chars-backward " \t")) + (skip-chars-backward "a-zA-Z0-9:_$") + (and (looking-at ctypes-identifier-regexp) + (regexp-quote + (buffer-substring-no-properties + (match-beginning 0) + (match-end 0)))))) + +;;}}} +;;{{{ Font-lock stuff + +;; This section contains some font-lock support functions. +;; +;; Even though the main purpose of the `ctypes' package is to enhance +;; the fontification of C-like languages, the design of the package +;; does not limit itself to such narrow goal. Should you prefer to +;; use ctypes to anything else just redefine `ctypes-mode-descriptor'. + + +(defun ctypes-font-lock-set-extra-types (mode extra-types-var) + "Add the new keywords to font-lock. +This function is used for font-lock versions that have native +support for extra types. As of this writing, no official releases +with this feature has been made." + (set extra-types-var (ctypes-get-types mode)) + (ctypes-font-lock-refontify mode)) + + +(defun ctypes-font-lock-refontify (mode) + "Refontify all buffers in major mode MODE." + (save-excursion + (let ((bufs (buffer-list))) + (while bufs + (set-buffer (car bufs)) + (if (and (eq major-mode mode) font-lock-mode) + (progn + (font-lock-mode -1) + (font-lock-mode 1))) + (setq bufs (cdr bufs)))))) + + +;; Code used by font-lock versions without native type support. + +(defvar ctypes-font-lock-keywords '() + "AList of all keywords installed by ctypes in font-lock keywords. + +This is needed when old keywords are replaced with newer.") + + +(defun ctypes-font-lock-add-keywords (mode rules) + "Add font-lock keywords for major mode MODE." + (let ((types (ctypes-get-types mode))) + (if (null types) + (ctypes-font-lock-delete-keywords mode rules) + (ctypes-font-lock-install-keywords + mode (mapconcat 'identity types "\\|") rules)) + (ctypes-font-lock-refontify mode))) + + +(defun ctypes-font-lock-install-keywords (mode regexp rules) + "Add REGEXP as new C-style types in major mode MODE. + +The rules is a list containing elements on the following form: + (number var [append]) + +Where `number' can be 1 or 2 and represents a simple and one complex +keyword, respectively. Normally, the simpler is defined at a lower +fontification but both are needed to get full fontification. + +`var' is the font-lock keyword variable to use and `append' is an +optional argument, when true the new keyword is appended to the end +of the keyword list." + (ctypes-font-lock-delete-keywords mode rules) + (let ((keyword-1 + (cons (concat "\\<\\(" regexp "\\)\\>") 'font-lock-type-face)) + (keyword-2 + (list + (concat "\\<\\(" regexp "\\)\\>\\([ \t*&]+\\sw+\\>\\)*") + ;; Fontify each declaration item. + (list 'font-lock-match-c++-style-declaration-item-and-skip-to-next + ;; Start with point after all type specifiers. + (list 'goto-char + (list 'or (list 'match-beginning + (+ 2 (regexp-opt-depth regexp))) + '(match-end 1))) + ;; Finish with point after first type specifier. + '(goto-char (match-end 1)) + ;; Fontify as a variable or function name. + '(1 (if (match-beginning 4) + font-lock-function-name-face + font-lock-variable-name-face)))))) + (setq ctypes-font-lock-keywords + (cons (list mode keyword-1 keyword-2) + ctypes-font-lock-keywords)) + (while rules + (let ((number (nth 0 (car rules))) + (var (nth 1 (car rules))) + (append-p (nth 2 (car rules))) + keywords) + (cond ((= number 1) + (setq keywords keyword-1)) + ((= number 2) + (setq keywords keyword-2)) + (t + (error "Incorrect entry in rule. Found `%s', expected 1 or 2." + number))) + (if append-p + (set var (append (symbol-value var) (list keywords))) + (set var (cons keywords (symbol-value var))))) + (setq rules (cdr rules))))) + + +(defun ctypes-font-lock-delete-keywords (mode rules) + "Delete keywords form major mode MODE, described by RULES. + +See the function `ctypes-font-lock-install-keywords' for a description +of RULES." + (let ((keywords (assq mode ctypes-font-lock-keywords))) + (if (null keywords) + () + (setq ctypes-font-lock-keywords + (delq keywords ctypes-font-lock-keywords)) + (setq keywords (cdr keywords)) ; Skip the mode name + (while rules + (let ((keywords keywords) ; Iteration-local alias + (var (nth 1 (car rules)))) + (while keywords + (set var (delq (car keywords) (symbol-value var))) + (setq keywords (cdr keywords)))) + (setq rules (cdr rules)))))) + +;;}}} + +;;{{{ Debug + +(defun ctypes-debug () + (interactive) + (with-output-to-temp-buffer "*CTypes-Debug*" + (princ "ctypes-types-alist:") + (print ctypes-types-alist) + (terpri) + + (princ "ctypes-font-lock-keywords:") + (print ctypes-font-lock-keywords) + (terpri) + + (princ "ctypes-delayed-action-list:") + (print ctypes-delayed-action-list) + (terpri))) + +;;}}} + +;; The End + +(add-hook 'find-file-hooks 'ctypes-find-file-hook) +(add-hook 'kill-emacs-hook 'ctypes-kill-emacs-hook) + +(provide 'ctypes) + +(run-hooks 'ctypes-load-hook) + +;; ctypes.el ends here. diff --git a/elisp/emacs-goodies-el/dedicated.el b/elisp/emacs-goodies-el/dedicated.el new file mode 100755 index 0000000..0db9d2c --- /dev/null +++ b/elisp/emacs-goodies-el/dedicated.el @@ -0,0 +1,53 @@ +;;; dedicated.el --- A very simple minor mode for dedicated buffers + +;; Copyright (C) 2000 Eric Crampton + +;; Author: Eric Crampton +;; Maintainer: Eric Crampton +;; Version: 1.0.0 +;; Keywords: dedicated, buffer + +;; 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: + +;; This minor mode allows you to toggle a window's "dedicated" flag. +;; When a window is "dedicated", Emacs will not select files into that +;; window. This can be quite handy since many commands will use +;; another window to show results (e.g., compilation mode, starting +;; info, etc.) A dedicated window won't be used for such a purpose. +;; +;; Dedicated buffers will have "D" shown in the mode line. + +;;; Code: + +(defvar dedicated-mode nil + "Mode variable for dedicated minor mode.") +(make-variable-buffer-local 'dedicated-mode) + +(defun dedicated-mode (&optional arg) + "Dedicated minor mode." + (interactive "P") + (setq dedicated-mode (not dedicated-mode)) + (set-window-dedicated-p (selected-window) dedicated-mode) + (if (not (assq 'dedicated-mode minor-mode-alist)) + (setq minor-mode-alist + (cons '(dedicated-mode " D") + minor-mode-alist)))) + +(provide 'dedicated) diff --git a/elisp/emacs-goodies-el/df.el b/elisp/emacs-goodies-el/df.el new file mode 100755 index 0000000..7196ca9 --- /dev/null +++ b/elisp/emacs-goodies-el/df.el @@ -0,0 +1,280 @@ +;;; df.el --- display space left on partitions in the mode-line + +;; Copyright (C) 1999 by Association April + +;; Author: Benjamin Drieu +;; Keywords: unix, tools + +;; This file is NOT part of GNU Emacs. + +;; GNU Emacs as this program are free software; you can redistribute +;; them and/or modify them 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. + +;; They are both distributed in the hope that they 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 quick hack to display disk usage in the mode-line. +;; Disk space remaining is updated every `df-refresh' seconds. + +;; If you work with a lot of users sharing the same partition, it +;; sometimes happens that there is no space left to save your work, which +;; may drive you to serious brain damage when you lose important work. +;; This package allows you to have the available disk space and the buffer +;; size displayed in the mode-line, so you know when you can save your +;; file or when it's time to do some cleanup. + +;; This package may (must) not be very optimized or efficient, but +;; this is a quick hack. Comments and suggestions are welcome. + +;; df is simple to use : +;; - Put this file in your load-path +;; and then +;; - Put the following in your .emacs : (autoload 'df "df" nil t) +;; - Add something like (df "/home") in your .emacs if you want to +;; scan /home +;; or more simply by using the custom interface: +;; M-x customize-group df +;; where you can toggle on `df-run-on-startup'. + +;;; History: +;; + +;; $Id: df.el,v 1.6 2009-09-04 01:44:56 psg Exp $ + +;; $Log: df.el,v $ +;; Revision 1.6 2009-09-04 01:44:56 psg +;; move df tweaks into main CVS +;; +;; Revision 1.5 2003-06-17 23:47:31 psg +;; Peter S Galbraith +;; - Add autoload for cancel-function-timers (for XEmacs). +;; +;; Revision 1.4 2003/06/17 02:05:26 psg +;; Peter S Galbraith +;; - Add customize support. Users can now enables `df' by simply +;; customizing variables `df-partition' and `df-run-on-startup'. +;; +;; Revision 1.3 2003/06/17 01:19:23 psg +;; Use mode-line with a hyphen, like elsewhere in Emacs. +;; +;; Revision 1.2 2003/06/17 01:02:20 psg +;; Make checkdoc clean +;; +;; Revision 1.1.1.1 2003/04/04 20:15:58 lolando +;; Initial import, based on version 19.2-1 currently in unstable. +;; +;; Revision 1.8 2001/12/07 13:08:16 benj +;; - fixed a misplaced (interactive) +;; +;; Revision 1.7 2000/06/05 11:19:22 benj +;; - put some variables local so buffer size is buffer-local +;; - add a hook to find-file-hook to display correct size +;; +;; Revision 1.6 1999/11/05 22:04:03 benj +;; - Now use a minor mode instead of that ugly dance with mode-line-format +;; - Really use variables instead of constants in the code +;; - Better structuration (df-enable and df-disable) +;; - Some more documentation +;; - Licence typos fixed +;; +;; Revision 1.5 1999/01/24 17:25:54 drieu +;; - Add Paal Steihaug remarks : +;; + use magic df argument, which only scan a partition +;; + add (require 'cl) +;; + df-update is now much clean +;; + df now use either 'df -m' or 'df -k' when it is needed +;; +;; Revision 1.4 1999/01/04 14:51:01 drieu +;; - Correct a bug so Megabytes are *REALLY* Megabytes +;; +;; Revision 1.3 1999/01/02 15:46:44 drieu +;; - Fix few bugs one more time +;; - Add variables instead of hard-coded strings +;; - Add argument for df +;; - Document the file a bit more +;; +;; Revision 1.2 1998/12/15 17:37:42 drieu +;; - Fix few bugs +;; - Add Buffer size in the mode line +;; - Mesure either in K or Mega bytes +;; - And so on... + +;;; Code: + +;; Variables that users will want to change +(defgroup df nil + "Display space left on partitions in the mode-line." + :group 'convenience) + +(defun df-list-partitions () + "Return list of mounted partition directories." + (with-temp-buffer + (insert-file-contents "/etc/mtab") + (let ((result)) + (while (re-search-forward "^/dev[^ ]+ \\([^ ]+\\)" nil t) + (if result + (add-to-list 'result (match-string 1)) + (setq result (list (match-string 1))))) + result))) + +(defcustom df-partition "/home" + "*Partition to scan by df package." + :group 'df + :load 'df + :type (append '(radio) + (nreverse + (cons + '(string :tag "Other directory") + (mapcar (function (lambda (arg) `(const ,arg))) + (df-list-partitions)))))) + +(defcustom df-run-on-startup nil + "*If non-nil, run `df' on Emacs startup." + :group 'df + :require 'df + :type 'boolean + :set (lambda (symbol value) + (set-default symbol value) + (if (and value df-partition) + (df)))) + +;; Variables that users are unlikely to want to change +(defvar df-refresh 60 + "*Refresh rate (in seconds) of the mode-line by df.") +(defvar df-mb-threshold 10 + "*When free disk space reaches this amount (in Mb), show in Mb.") +(defvar df-megabytes-unit "M" + "String used for displaying megabytes.") +(defvar df-kilobytes-unit "K" + "String used for displaying kilobytes.") +(defvar df-command "df" + "*Command used to get disk usage (usually df).") +(defvar df-in-kilobytes "-k" + "*Argument to use when `df-command' works in kilobytes.") +(defvar df-in-megabytes "-m" + "*Argument to use when `df-command' works in megabytes.") +(defvar df-command-arguments df-in-kilobytes + "*Arguments for `df-command'.") + +;; Seemless variables to the end user. +(defvar df-space-left "" + "Space left on device.") +(defvar df-unit nil + "Unit (either M or K) used for space left.") +(defvar df-mode nil) +(defvar df-string "") +(defvar df-buffer-weight "") + +;; Needed because of the 'when' construct +(require 'cl) +(autoload 'cancel-function-timers "timer" + "Cancel all timers scheduled by `run-at-time' which would run FUNCTION." + t) + +(defun df-update () + "Function to update disk usage. It is used every `df-refresh' seconds." + (interactive) + (set-variable + 'df-buffer-weight (int-to-string (/ (length (buffer-string)) 1000))) + (cond + ((> (string-to-int df-space-left) (* df-mb-threshold 1000)) + (set-variable 'df-unit df-megabytes-unit) + (setq df-command-arguments df-in-megabytes)) + ((and (< (string-to-int df-space-left) df-mb-threshold) + (string-equal df-command-arguments df-in-megabytes)) + (set-variable 'df-unit df-kilobytes-unit) + (setq df-command-arguments df-in-kilobytes)) + ((not df-unit) + (set-variable 'df-unit df-kilobytes-unit))) + (set-process-filter + (start-process df-command nil df-command df-command-arguments df-partition) + 'df-filter)) + + + +(defun df-filter (proc string) + "Filter for df output. +This function is responsible from updating the mode-line from the df process. +Argument PROC is the df process. +Argument STRING is the output string." + (when (string-match (format "\\(-?[0-9]+\\) *[0-9%%]+ *%s" df-partition) string) + (setq df-space-left (match-string 1 string)) + (if (> (string-to-int df-space-left) 1000) + (set-variable 'df-unit df-megabytes-unit) + (set-variable 'df-unit df-kilobytes-unit)) + (when (equal df-unit df-megabytes-unit) + (setq df-space-left (substring df-space-left 0 (- (length df-space-left) 3))))) + (setq df-string (format " %s%s/%s%s" df-buffer-weight df-kilobytes-unit df-space-left df-unit))) + + + +(defun df-disable () + "Stop all command `df-mode' actions." + (interactive) + (setq df-mode nil) + (cancel-function-timers 'df-update)) + + + +(defun df-enable () + "Function to display disk statistics in the mode-line." + (interactive) + (setq df-mode t) + (make-variable-buffer-local 'df-buffer-weight) + (make-variable-buffer-local 'df-string) +;;(set-default 'df-string " plop") + (run-with-timer 0 df-refresh 'df-update) + (if (not (assq 'df-mode minor-mode-alist)) + (setq minor-mode-alist + (cons '(df-mode df-string) minor-mode-alist))) + (add-hook 'find-file-hooks 'df-update) +;;(add-hook 'write-file-hooks 'df-check) + (df-update)) + + + +;;;(defun df-check () + ; ca servira plus tard a + ; demander si on est sur de + ; sauvegarder le fichier quand + ; meme +;;; ) + + +(defun df-mode (&optional arg) + "Toggle display of space left on any filesystem in mode-lines. +This display updates automatically every `df-refresh' seconds. + +With a numeric argument, enable this display if ARG is positive." + (interactive) + (if + (if (null arg) (not df-mode) + (> (prefix-numeric-value arg) 0)) + (df-enable) + (df-disable))) + + + +;;;###autoload +(defun df (&optional partition) + "Enables display of space left on any PARTITION in mode-lines. +This display updates automatically every `df-refresh' seconds." + (interactive) + (when partition + (set-variable 'df-partition partition)) + (df-mode 1)) + +(provide 'df) +;;; df.el ends here diff --git a/elisp/emacs-goodies-el/diminish.el b/elisp/emacs-goodies-el/diminish.el new file mode 100755 index 0000000..6461e12 --- /dev/null +++ b/elisp/emacs-goodies-el/diminish.el @@ -0,0 +1,293 @@ +;;; diminish.el --- Diminished modes are minor modes with no modeline display + +;; Copyright (C) 1998 Free Software Foundation, Inc. + +;; Author: Will Mengarini +;; URL: +;; Created: Th 19 Feb 98 +;; Version: 0.44, Sa 23 Jan 99 +;; Keywords: extensions, diminish, minor, codeprose + +;; This file is part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with 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: + +;; Minor modes each put a word on the mode line to signify that they're +;; active. This can cause other displays, such as % of file that point is +;; at, to run off the right side of the screen. For some minor modes, such +;; as mouse-avoidance-mode, the display is a waste of space, since users +;; typically set the mode in their .emacs & never change it. For other +;; modes, such as my jiggle-mode, it's a waste because there's already a +;; visual indication of whether the mode is in effect. + +;; A diminished mode is a minor mode that has had its mode line +;; display diminished, usually to nothing, although diminishing to a +;; shorter word or a single letter is also supported. This package +;; implements diminished modes. + +;; You can use this package either interactively or from your .emacs file. +;; In either case, first you'll need to copy this file to a directory that +;; appears in your load-path. `load-path' is the name of a variable that +;; contains a list of directories Emacs searches for files to load. +;; To prepend another directory to load-path, put a line like +;; (add-to-list 'load-path "c:/My_Directory") in your .emacs file. + +;; To create diminished modes interactively, type +;; M-x load-library +;; to get a prompt like +;; Load library: +;; and respond `diminish' (unquoted). Then type +;; M-x diminish +;; to get a prompt like +;; Diminish what minor mode: +;; and respond with the name of some minor mode, like mouse-avoidance-mode. +;; You'll then get this prompt: +;; To what mode-line display: +;; Respond by just hitting if you want the name of the mode +;; completely removed from the mode line. If you prefer, you can abbreviate +;; the name. If your abbreviation is 2 characters or more, such as "Av", +;; it'll be displayed as a separate word on the mode line, just like minor +;; modes' names. If it's a single character, such as "V", it'll be scrunched +;; up against the previous word, so for example if the undiminished mode line +;; display had been "Abbrev Fill Avoid", it would become "Abbrev FillV". +;; Multiple single-letter diminished modes will all be scrunched together. +;; The display of undiminished modes will not be affected. + +;; To find out what the mode line would look like if all diminished modes +;; were still minor, type M-x diminished-modes. This displays in the echo +;; area the complete list of minor or diminished modes now active, but +;; displays them all as minor. They remain diminished on the mode line. + +;; To convert a diminished mode back to a minor mode, type M-x diminish-undo +;; to get a prompt like +;; Restore what diminished mode: +;; Respond with the name of some diminished mode. To convert all +;; diminished modes back to minor modes, respond to that prompt +;; with `diminished-modes' (unquoted, & note the hyphen). + +;; When you're responding to the prompts for mode names, you can use +;; completion to avoid extra typing; for example, m o u SPC SPC SPC +;; is usually enough to specify mouse-avoidance-mode. Mode names +;; typically end in "-mode", but for historical reasons +;; auto-fill-mode is named by "auto-fill-function". + +;; To create diminished modes noninteractively in your .emacs file, put +;; code like +;; (require 'diminish) +;; (diminish 'abbrev-mode "Abv") +;; (diminish 'jiggle-mode) +;; (diminish 'mouse-avoidance-mode "M") +;; near the end of your .emacs file. It should be near the end so that any +;; minor modes your .emacs loads will already have been loaded by the time +;; they're to be converted to diminished modes. + +;; To diminish a major mode, (setq mode-name "whatever") in the mode hook. + +;;; Epigraph: + +;; "The quality of our thoughts is bordered on all sides +;; by our facility with language." +;; --J. Michael Straczynski + +;;; Code: + +(eval-when-compile (require 'cl)) + +(defvar diminish-must-not-copy-minor-mode-alist nil + "Non-nil means loading diminish.el won't (copy-alist minor-mode-alist). +Normally `minor-mode-alist' is setq to that copy on loading diminish because +at least one of its cons cells, that for abbrev-mode, is read-only (see +ELisp Info on \"pure storage\"). If you setq this variable to t & then +try to diminish abbrev-mode under GNU Emacs 19.34, you'll get the error +message \"Attempt to modify read-only object\".") + +(or diminish-must-not-copy-minor-mode-alist + (callf copy-alist minor-mode-alist)) + +(defvar diminished-mode-alist nil + "The original `minor-mode-alist' value of all (diminish)ed modes.") + +(defvar diminish-history-symbols nil + "Command history for symbols of diminished modes.") + +(defvar diminish-history-names nil + "Command history for names of diminished modes.") + +;; When we diminish a mode, we are saying we want it to continue doing its +;; work for us, but we no longer want to be reminded of it. It becomes a +;; night worker, like a janitor; it becomes an invisible man; it remains a +;; component, perhaps an important one, sometimes an indispensable one, of +;; the mechanism that maintains the day-people's world, but its place in +;; their thoughts is diminished, usually to nothing. As we grow old we +;; diminish more and more such thoughts, such people, usually to nothing. + +;; "The wise man knows that to keep under is to endure." The diminished +;; often come to value their invisibility. We speak--speak--of "the strong +;; silent type", but only as a superficiality; a stereotype in a movie, +;; perhaps, but even if an acquaintance, necessarily, by hypothesis, a +;; distant one. The strong silent type is actually a process. It begins +;; with introspection, continues with judgment, and is shaped by the +;; discovery that these judgments are impractical to share; there is no +;; appetite for the wisdom of the self-critical among the creatures of +;; material appetite who dominate our world. Their dominance's Darwinian +;; implications reinforce the self-doubt that is the germ of higher wisdom. +;; The thoughtful contemplate the evolutionary triumph of the predator. +;; Gnostics deny the cosmos could be so evil; this must all be a prank; the +;; thoughtful remain silent, invisible, self-diminished, and discover, +;; perhaps at first in surprise, the freedom they thus gain, and grow strong. + +;;;###autoload +(defun diminish (mode &optional to-what) + "Diminish mode-line display of minor mode MODE to TO-WHAT (default \"\"). + +Interactively, enter (with completion) the name of any minor mode, followed +on the next line by what you want it diminished to (default empty string). +The response to neither prompt should be quoted. However, in Lisp code, +both args must be quoted, the first as a symbol, the second as a string, +as in (diminish 'jiggle-mode \" Jgl\"). + +The mode-line displays of minor modes usually begin with a space, so +the modes' names appear as separate words on the mode line. However, if +you're having problems with a cramped mode line, you may choose to use single +letters for some modes, without leading spaces. Capitalizing them works +best; if you then diminish some mode to \"X\" but have abbrev-mode enabled as +well, you'll get a display like \"AbbrevX\". This function prepends a space +to TO-WHAT if it's > 1 char long & doesn't already begin with a space." + (interactive (list (read (completing-read + "Diminish what minor mode: " + (mapcar (lambda (x) (list (symbol-name (car x)))) + minor-mode-alist) + nil t nil 'diminish-history-symbols)) + (read-from-minibuffer + "To what mode-line display: " + nil nil nil 'diminish-history-names))) + (let ((minor (assq mode minor-mode-alist))) + (or minor (error "%S is not currently registered as a minor mode" mode)) + (callf or to-what "") + (when (> (length to-what) 1) + (or (= (string-to-char to-what) ?\ ) + (callf2 concat " " to-what))) + (or (assq mode diminished-mode-alist) + (push (copy-sequence minor) diminished-mode-alist)) + (setcdr minor (list to-what)))) + +;; But an image comes to me, vivid in its unreality, of a loon alone on his +;; forest lake, shrieking his soul out into a canopy of stars. Alone this +;; afternoon in my warm city apartment, I can feel the bite of his night air, +;; and smell his conifers. In him there is no acceptance of diminishment. + +;; "I have a benevolent habit of pouring out myself to everybody, +;; and would even pay for a listener, and I am afraid +;; that the Athenians may think me too talkative." +;; --Socrates, in the /Euthyphro/ + +;; I remember a news story about a retired plumber who had somehow managed to +;; steal a military tank. He rode it down city streets, rode over a parked +;; car--no one was hurt--rode onto a freeway, that concrete symbol of the +;; American spirit, or so we fancy it, shouting "Plumber Bob! Plumber Bob!". +;; He was shot dead by police. + +;;;###autoload +(defun diminish-undo (mode) + "Restore mode-line display of diminished mode MODE to its minor-mode value. +Do nothing if the arg is a minor mode that hasn't been diminished. + +Interactively, enter (with completion) the name of any diminished mode (a +mode that was formerly a minor mode on which you invoked M-x diminish). +To restore all diminished modes to minor status, answer `diminished-modes'. +The response to the prompt shouldn't be quoted. However, in Lisp code, +the arg must be quoted as a symbol, as in (diminish-undo 'diminished-modes)." + (interactive + (list (read (completing-read + "Restore what diminished mode: " + (cons (list "diminished-modes") + (mapcar (lambda (x) (list (symbol-name (car x)))) + diminished-mode-alist)) + nil t nil 'diminish-history-symbols)))) + (if (eq mode 'diminished-modes) + (let ((diminished-modes diminished-mode-alist)) + (while diminished-modes + (diminish-undo (caar diminished-modes)) + (callf cdr diminished-modes))) + (let ((minor (assq mode minor-mode-alist)) + (diminished (assq mode diminished-mode-alist))) + (or minor + (error "%S is not currently registered as a minor mode" mode)) + (when diminished + (setcdr minor (cdr diminished)))))) + +;; Plumber Bob was not from Seattle, my grey city, for rainy Seattle is a +;; city of interiors, a city of the self-diminished. When I moved here one +;; sunny June I was delighted to find that ducks and geese were common in +;; the streets. But I hoped to find a loon or two, and all I found were +;; ducks and geese. I wondered about this; I wondered why there were no +;; loons in Seattle; but my confusion resulted from my ignorance of the +;; psychology of rain, which is to say my ignorance of diminished modes. +;; What I needed, and lacked, was a way to discover they were there. + +;;;###autoload +(defun diminished-modes () + "Echo all active diminished or minor modes as if they were minor. +The display goes in the echo area; if it's too long even for that, +you can see the whole thing in the *Messages* buffer. +This doesn't change the status of any modes; it just lets you see +what diminished modes would be on the mode-line if they were still minor." + (interactive) + (let ((minor-modes minor-mode-alist) + message) + (while minor-modes + (when (symbol-value (caar minor-modes)) + ;; This minor mode is active in this buffer + (let* ((mode-pair (car minor-modes)) + (mode (car mode-pair)) + (minor-pair (or (assq mode diminished-mode-alist) mode-pair)) + (minor-name (cadr minor-pair))) + (when (symbolp minor-name) + ;; This minor mode uses symbol indirection in the cdr + (let ((symbols-seen (list minor-name))) + (while (and (symbolp (callf symbol-value minor-name)) + (not (memq minor-name symbols-seen))) + (push minor-name symbols-seen)))) + (push minor-name message))) + (callf cdr minor-modes)) + (setq message (mapconcat 'identity (nreverse message) "")) + (when (= (string-to-char message) ?\ ) + (callf substring message 1)) + (message "%s" message))) + +;; A human mind is a Black Forest of diminished modes. Some are dangerous; +;; most of the mind of an intimate is a secret stranger, and these diminished +;; modes are rendered more unpredictable by their long isolation from the +;; corrective influence of interaction with reality. The student of history +;; learns that this description applies to whole societies as well. In some +;; ways the self-diminished are better able to discern the night worker. +;; They are rendered safer by their heightened awareness of others' +;; diminished modes, and more congenial by the spare blandness of their own +;; mode lines. To some people rain is truly depressing, but others it just +;; makes pensive, and, forcing them indoors where they may not have the +;; luxury of solitude, teaches them to self-diminish. That was what I had +;; not understood when I was searching for loons among the ducks and geese. +;; Loons come to Seattle all the time, but the ones that like it learn to be +;; silent, learn to self-diminish, and take on the colors of ducks and geese. +;; Now, here a dozen years, I can recognize them everywhere, standing quietly +;; in line with the ducks and geese at the espresso counter, gazing placidly +;; out on the world through loon-red eyes, thinking secret thoughts. + +(provide 'diminish) + +;;; diminish.el ends here \ No newline at end of file diff --git a/elisp/emacs-goodies-el/dir-locals.el b/elisp/emacs-goodies-el/dir-locals.el new file mode 100755 index 0000000..7ff1380 --- /dev/null +++ b/elisp/emacs-goodies-el/dir-locals.el @@ -0,0 +1,183 @@ +;;; dir-locals.el --- Local variables for a directory tree + +;; Copyright (C) 2005, 2006 Free Software Foundation, Inc. + +;; Author: Dave Love +;; Keywords: files +;; $Revision: 1.1 $ +;; URL: http://www.loveshack.ukfsn.org/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: + +;; It can be useful to specify local variables directory-wide, e.g. to +;; define CC mode styles consistently. This library implements such a +;; scheme, controlled by the global minor mode `dir-locals-mode'. + +;; Place a file named `.emacs-locals' (or the value of +;; `dir-locals-file-name') in the directory root. This should specify +;; local variables in the usual way. The values it sets are inherited +;; when a file in the directory tree is found. Local variables +;; specified in the found file override the directory-wide ones. + +;; However, `eval' pseudo-variables specified in the file are +;; evaluated (assuming `enable-local-eval' is true) _before_ any +;; directory-wide processing, and they are evaluated in a scratch +;; buffer, so that they are only useful for side effects on local +;; variables. `mode' pseudo-variables which specify minor modes +;; toggle those modes for files within the directory. If +;; .emacs-locals specifies a major mode, it doesn't propagate, but any +;; local variables and minor modes its hook sets will; thus it should +;; normally not specify a major mode. The `coding' pseudo-variable +;; will not propagate from .emacs-locals. + +;; For example, with dir-locals mode on, placing this in .emacs-locals +;; at the top-level of the Linux source tree would set the C +;; indentation style appropriately for files within the tree: +;; +;; Local variables: +;; c-file-style: "linux" +;; End: +;; +;; (and ignore the stupid remarks in Documentation/CodingStyle). + +;; Another possible use is, say, setting change-log parameters in +;; different trees for which the Emacs 22 development source broke use +;; of change-log-mode-hook. + +;; NB: This doesn't work with some versions of the Emacs 22 codebase +;; which changed the way hack-local-variables-hook is run, but the +;; change has been reverted. + +;; Another, less clean, implementation of this sort of thing was +;; posted to gnu-emacs-sources as dirvals.el by Benjamin Rutt +;; , June 2006, based on work by Matt Armstrong +;; . It uses a different format for the equivalent +;; of .emacs-locals. + +;;; Code: + +(defgroup dir-locals () + "Directory-wide file-local variables" + :link '(emacs-commentary-link "dir-locals") + :group 'files) + +(defcustom dir-locals-file-name ".emacs-locals" + "File name used by Dir-Locals mode to specify local variables. +This should specify local variables in the normal way. When Dir-Locals +minor mode is active, these will be inherited by files found in a +directory tree containing such a file at its root. + +This may also be a function of no arguments which returns the name to +use, allowing arbitrary per-directory customization of the +per-directory customization file on the basis of `default-directory'." + :group 'dir-locals + :type '(choice file function)) + +;; Adapted from dirvals.el. +(defcustom dir-locals-chase-remote nil + "Non-nil means search upwards for `dir-locals-file-name' in remote filesystem." + :group 'dir-locals + :type 'boolean) + +(define-minor-mode dir-locals-mode + "Toggle use of directory-wide file-local variables. +See `dir-locals-file-name'." + :global t + (if dir-locals-mode + (add-hook 'hack-local-variables-hook 'dir-locals-hack-local-variables) + (remove-hook 'hack-local-variables-hook + 'dir-locals-hack-local-variables))) + +;; Following find-change-log. Fixme: Should be abstracted from there. +(defun dir-locals-tree-find (file) + "Find FILE in the current directory or one of its parents. +If one is found, return its fully-qualified name, otherwise return +nil. + +FILE may be a string or a nullary function returning one on the basis +of `default-directory'." + (unless (and (not dir-locals-chase-remote) + (fboundp 'file-remote-p) ; not in Emacs 21 + (file-remote-p default-directory)) + (let* ((dir-name + ;; Chase links in the source file and start searching in + ;; the dir where it resides. + (or (if buffer-file-name + (file-name-directory (file-chase-links buffer-file-name))) + default-directory)) + (file (if (functionp file) + (funcall file) + file)) + (file1 (if (file-directory-p dir-name) + (expand-file-name file dir-name)))) + ;; Chase links before visiting the file. This makes it easier + ;; to use a file for several related directories. + (setq file1 (expand-file-name (file-chase-links file1))) + ;; Move up in the dir hierarchy till we find a suitable file. + (while (and (not (file-exists-p file1)) + (setq dir-name (file-name-directory + (directory-file-name + (file-name-directory file1)))) + ;; Give up if we are already at the root dir. + (not (string= (file-name-directory file1) dir-name))) + ;; Move up to the parent dir and try again. + (setq file1 (expand-file-name (file-name-nondirectory file) dir-name))) + (if (file-exists-p file1) + file1)))) + +(defun dir-locals-hack-local-variables () + "Set local variables from directory-wide values. +Inherit the local variables set in `dir-locals-file-name' if that is +found by `dir-locals-tree-find'. Ignore everything ignored by +`hack-local-variables'." + (let* ((file (dir-locals-tree-find dir-locals-file-name)) + (hack-local-variables-hook nil) + (buffer-file + (if buffer-file-name + (expand-file-name (file-chase-links buffer-file-name)))) + ;; Fixme: Probably condition-case this and ensure any error + ;; messages indicate the directory file. + (vars (when (and file + ;; Don't do it twice, so as to avoid + ;; repeating possible interactive queries. + (not (equal file buffer-file))) + (with-temp-buffer + ;; Make queries from `hack-local-variables' clearer. + (rename-buffer (file-name-nondirectory file) t) + (insert-file-contents file) + (let* ((locals (buffer-local-variables)) + (_ (hack-local-variables)) + (new-locals (buffer-local-variables))) + ;; Derive the list of new pairs. + (dolist (l locals) + (setq new-locals (delete l new-locals))) + ;; And some internals which get updated. + (dolist (l '(buffer-display-time buffer-display-count)) + (setq new-locals (assq-delete-all l new-locals))) + new-locals))))) + (dolist (v vars) + (let ((sym (car v))) + (unless (local-variable-p sym) ; file-locals take precedence + (if (and (string-match "-mode\\'" (symbol-name sym)) + (fboundp sym)) + (funcall sym) + (set (make-local-variable sym) (cdr v)))))))) + +(provide 'dir-locals) + +;;; dir-locals.el ends here diff --git a/elisp/emacs-goodies-el/edit-env.el b/elisp/emacs-goodies-el/edit-env.el new file mode 100755 index 0000000..8f2bcd1 --- /dev/null +++ b/elisp/emacs-goodies-el/edit-env.el @@ -0,0 +1,186 @@ +;;; edit-env.el --- display and edit environment variables + +;; Copyright (C) 2001 Benjamin Rutt +;; +;; Maintainer: Benjamin Rutt +;; Version: 1.0 + +;; 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 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 GNU Emacs; see the file COPYING. If not, send e-mail to +;; this program's maintainer or write to the Free Software Foundation, +;; Inc., 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; This file uses the widget library to display, edit, delete and add +;; environment variables. Inspired by "G c" in a gnus *Group* buffer. +;; Bug reports or patches are welcome, please use the above email +;; address. + +;;; Usage: + +;; put this file in your load-path and add the line +;; +;; (require 'edit-env) +;; +;; to your ~/.emacs file. +;; +;; Then, type +;; +;; M-x edit-env +;; +;; to enter the environment editor. To change variables, simply edit +;; their values in place. To delete variables, delete their values. +;; To add variables, add a new rows to the list at the bottom by +;; pressing [INS]; then, add a new name/value pair of the form +;; VAR=VALUE (e.g. FOO=BAR). After changing and/or deleting and/or +;; adding environment variables, press the [done] button at the top. +;; Note that environment variable changes will only be visible to your +;; current emacs session or child processes thereof. + +;;; Code: + +;; XEmacs compatibility stuff +(if (string-match "XEmacs" (emacs-version)) + (require 'overlay)) + +(require 'widget) + +(require 'wid-edit) +(eval-when-compile (require 'cl)) + +(defvar edit-env-ls nil) +(defvar edit-env-changed-ls nil) +(defvar edit-env-added-ls nil) + +(defun edit-env-update () + (let ((var nil) + (value nil) + (vars-changed nil)) + (when edit-env-changed-ls + (mapcar + (lambda (x) + (setq var (car x)) + (setq value (widget-value (cadr x))) + (if (equal value "") + (setenv var nil) ;; i.e. unset var + (setenv var value)) + (add-to-list 'vars-changed var)) + edit-env-changed-ls) + (setq edit-env-changed-ls nil)) + + (when edit-env-added-ls + (mapcar + (lambda (x) + (if (and x (not (string-match "^[ \t\n]*$" x))) + (progn + (let ((splits (split-string x "="))) + (if (not (= (length splits) 2)) + (message "invalid format %s" x) + (setq var (car splits)) + (setq value (cadr splits)) + (if value (add-to-list 'vars-changed var)) + (setenv var value)))))) + (widget-value edit-env-added-ls)) + (setq edit-env-added-ls nil)) + (when vars-changed + ;; Need to regenerate the buffer before burial. An alternative + ;; to re-generation followed by burial would be simply to + ;; kill-buffer. + (edit-env) + (message + (format "Updated environment variable%s %s" + (if (> (length vars-changed) 1) "s" "") + (mapconcat 'identity vars-changed ", ")))) + (bury-buffer))) + +(defun edit-env-mark-changed (widget) + (add-to-list 'edit-env-changed-ls + (list (widget-get widget 'environment-variable-name) + widget))) + +(defun edit-env () + "Display, edit, delete and add environment variables." + (interactive) + (setq edit-env-ls nil + edit-env-changed-ls nil + edit-env-added-ls nil) + (switch-to-buffer "*Environment Variable Editor*") + (kill-all-local-variables) + (let ((inhibit-read-only t)) + (erase-buffer)) + (let ((all (overlay-lists))) + ;; Delete all the overlays. + (mapcar 'delete-overlay (car all)) + (mapcar 'delete-overlay (cdr all))) + (widget-insert "Edit environment variables below, and press ") + (let ((pair nil) + (var nil) + (val nil) + (longest-var 0) + (current-widget nil)) + (setq edit-env-ls (copy-list process-environment)) + (setq edit-env-ls (sort edit-env-ls (lambda (a b) (string-lessp a b)))) + + (widget-create 'push-button + :notify (lambda (widget &rest ignore) + (edit-env-update)) + :help-echo "press to update environment variables" + "done") + (widget-insert ".\n") + + (mapcar + (lambda (x) + (let* ((pair (split-string x "=")) + (var (car pair)) + (val (cadr pair))) + (setq longest-var (max longest-var (length var))))) + edit-env-ls) + (mapcar + (lambda (x) + (let* ((pair (split-string x "=")) + (var (car pair)) + (val (or (cadr pair) ""))) + (widget-insert "\n") + (widget-insert (format (format "%%%ds" (1+ longest-var)) var)) + (widget-insert " ") + (setq current-widget + (widget-create 'editable-field + :size (1- (length val)) + :notify (lambda (widget &rest ignore) + (edit-env-mark-changed widget)) + :format "%v" val)) + (widget-put current-widget 'environment-variable-name var))) + edit-env-ls) + (widget-insert "\n\nTo add environment variables, ") + (widget-insert "add rows of the form VAR=VALUE\n") + (widget-insert "to the following list:\n") + (setq edit-env-added-ls + (widget-create + 'editable-list + :entry-format "%i %d %v" + :value nil + '(editable-field :value ""))) + (use-local-map widget-keymap) + (widget-setup) + (setq truncate-lines t) + ;; in future GNU emacs >= 21, auto-show-mode may be removed. + (when (fboundp 'auto-show-mode) + (auto-show-mode 1)) + (goto-char (point-min)))) + +(provide 'edit-env) + +;;; edit-env.el ends here diff --git a/elisp/emacs-goodies-el/egocentric.el b/elisp/emacs-goodies-el/egocentric.el new file mode 100755 index 0000000..61eca80 --- /dev/null +++ b/elisp/emacs-goodies-el/egocentric.el @@ -0,0 +1,336 @@ +;;; @(#) egocentric.el --- highlight your name inside emacs buffers + +;;; @(#) $Id: egocentric.el,v 1.3 2013/12/04 22:32:10 psg Exp $ + +;; This file is *NOT* part of GNU Emacs. + +;; Copyright (C) 2001-2010 by Benjamin Drieu +;; Author: Benjamin Drieu +;; Maintainer: Benjamin Drieu +;; Created: 2001-04-23 +;; Keywords: convenience + +;; LCD Archive Entry: +;; egocentric|Benjamin Drieu|bdrieu@april.org| +;; Highlight occurences of your name in buffers| +;; 23-Apr-2001|$Revision: 1.3 $|~/misc/egocentric.el| + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation; either version 2, or (at +;; your option) any later version. + +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; This package highlights occurrences of your own name and/or +;; nickname. Quite useful for daily kibozing. + +;; Main purpose is to be used within your favourite Emacs mailer. To +;; use egocentric.el with Gnus, simply use the following inside your +;; Gnus init file. +;; +;; (add-hook 'gnus-article-prepare-hook 'egocentric-mode) +;; (autoload 'egocentric-mode "egocentric" +;; "Highlight your name or various keywords in buffers") + +;;; To do: + +;; - take care of all sorts of accents +;; - if $NAME isn't set, get it from other sources + + +;;; History: +;; + +;;; Code: + +(provide 'egocentric) + +;; Various customization + +(defgroup egocentric nil + "Highlight your name in arbitrary buffers." + :group 'files + :group 'convenience) + +(defcustom egocentric-additional-keywords nil + "*Additionnal keywords to highlight added by user." + :type '(choice (const nil) (repeat string)) + :group 'egocentric) + +(defcustom egocentric-additional-regexps nil + "*Additionnal regexps to highlight added by user." + :type '(choice (const nil) (repeat string)) + :group 'egocentric) + +(defcustom egocentric-accents-translation-alist + `(("" . "\\(e\\|\\|=E9\\)") + ("" . "\\(e\\|\\|=E8\\)") + ("" . "\\(e\\|\\|=EA\\)") + ("" . ,(concat "\\(i\\|\\|=EF\\)"))) ; [TODO] contribute here ;-) + "Translation from accents to ''generic'' regexps." + :type 'alist + :group 'egocentric) + + +(defvar egocentric-mode nil + "*Egocentric mode. Highlights your name and additional keywords in arbitrary buffers.") +(make-variable-buffer-local 'egocentric-mode) + +(defface egocentric-face + '((((class grayscale) (background light)) (:background "DimGray" :underline t)) + (((class grayscale) (background dark)) (:background "LightGray" :underline t)) + (((class color) (background light)) (:background "Cyan" :foreground "Red" :underline t)) + (((class color) (background dark)) (:background "Purple4" :foreground "Yellow" :underline t)) + (t (:bold t :underline t))) + "Face used to highlight occurences of your name in `egocentric-mode'." + :group 'font-lock-highlighting-faces) + +(defvar egocentric-face 'egocentric-face + "Face name to use for occurences of your name in `egocentric-mode'.") + +(defvar egocentric-overlay-list nil + "List of overlays used to highlight occurences of your name in `egocentric-mode'.") +(make-local-variable 'egocentric-overlay-list) + +(defvar egocentric-regexp-list nil + "Regexp used to check whether a word has to be highlighted. +Automagically generated once since only schizophrenics are supposed to +change their name at run time. Use `egocentric-update-regexp-list' to +update it manually") + +(defvar egocentric-old-point nil + "Used to check old point when point moved in a ''egocentriced'' buffer. +This is definitively *gruuuuuik*") + + +;; Mode line stuff +(or (assoc 'egocentric-mode minor-mode-alist) + (setq minor-mode-alist + (cons '(egocentric-mode " Ego") minor-mode-alist))) + + +;;;###autoload +(defun egocentric-mode (&optional arg) + "Toggle egocentric mode. +Optional argument ARG is an optional boolean controling whether egocentric-mode should be turned on/off." + (interactive "P") + + (let ((old-egocentric-mode egocentric-mode)) + ;; Mark the mode as on or off. + (setq egocentric-mode (not (or (and (null arg) egocentric-mode) + (<= (prefix-numeric-value arg) 0)))) + ;; Do the real work. + (unless (eq egocentric-mode old-egocentric-mode) + (if egocentric-mode + (egocentric-mode-on) + (egocentric-mode-off))))) + + +;;;###autoload +(defun egocentric-mode-on () + "Turn Egocentric mode on." + (interactive) + (make-local-hook 'post-command-hook) + (add-hook 'post-command-hook (function egocentric-post-command-hook) t t) + (egocentric-update-regexp-list) + (egocentric-insinuate egocentric-regexp-list) + (run-hooks 'egocentric-mode-hook)) + + +;;;###autoload +(defun egocentric-mode-off () + "Turn Egocentric mode off." + (interactive) + (remove-hook 'post-command-hook (function egocentric-post-command-hook) t) + (egocentric-delete-all-overlays) + (setq egocentric-mode nil)) + + +;;;###autoload +(defun egocentric-update-regexp-list () + "Update ``egocentric-regexp-list'' from $USER and $NAME variables." + (interactive) + (setq egocentric-regexp-list (egocentric-make-regexp-list))) + + +(defun egocentric-make-regexp-list () + "Build a regexp list from USER and NAME environment variables. +It assumes that the NAME environment variable is set to your actual +name, like NAME=\"Benjamin Drieu\". This is not standard but some +systems use it." + (append + (mapcar + (lambda (word) + (concat "\\<" (downcase (egocentric-unac-word word)) "\\>")) + (let ((user (getenv "USER")) + (name (getenv "NAME"))) + (append + (when (and user (not (member user egocentric-additional-keywords))) + (list user)) + (when (and name + (not (equal name user))) + (split-string name)) + egocentric-additional-keywords))) + egocentric-additional-regexps)) + + +(defun egocentric-unac-word (word) + "Wipe out accents from a WORD. Call `egocentric-unac-word-1' as a ''recursor''." + (egocentric-unac-word-1 word egocentric-accents-translation-alist)) + + +(defun egocentric-unac-word-1 (word list) + "''Resursor'' for `egocentric-unac-word'. +Argument WORD is passed from it caller. +Argument LIST is an alist of regexps/replacements." + (cond + ((null list) word) + ((string-match (caar list) word) + (egocentric-unac-word-1 (egocentric-replace-all word (caar list) (cdar list)) + (cdr list))) + ((egocentric-unac-word-1 word (cdr list))))) + + +(defun egocentric-replace-all (word from to) + "Quick-n-dirty implementation of `replace-regexp'. +`replace-regexp' doesn't really work like it should or like I understand it. +I know ... i know ... this may sounds like using a hammer to squash +grasshoppers. +Argument WORD is the word to replace. +Argument FROM is a letter to remplace by TO." + (egocentric-replace-all-1 (split-string word "") from to)) + + +(defun egocentric-replace-all-1 (word from to) + "''Resursor'' for `egocentric-replace-all'. +Argument WORD is passed from `egocentric-replace-all'. +Occurences or argument FROM are replaced by TO." + (cond + ((null word) "") + ((equal (car word) from) + (concat to + (egocentric-replace-all-1 (cdr word) from to))) + ((concat (car word) + (egocentric-replace-all-1 (cdr word) from to))))) + + +(defun egocentric-post-command-hook () + "Function called as `post-command-hook' in ''egocentriced'' buffers." + (if (not (equal (point) egocentric-old-point)) + (progn + (if (not (null egocentric-old-point)) + (egocentric-check-at egocentric-old-point)) + (setq egocentric-old-point (point)))) + (egocentric-check-at (point))) + + +(defun egocentric-check-at (pos) + "Check whether word at POS (defaulted to point) is to be highlighted." + (save-excursion + (if (not (equal (point) pos)) + (goto-char pos)) + (let ((word (thing-at-point 'symbol))) + (if word + (if (egocentric-word-is-keyword word) + (egocentric-highlight-word pos) + (if (egocentric-overlay-at pos) + (egocentric-unhighlight-at pos)) + (if (egocentric-overlay-at (1- pos)) + (egocentric-unhighlight-at (1- pos)))))))) + + +(defun egocentric-word-is-keyword (word) + "Check wether WORD is a keyword to be highlighted." + (if (stringp word) + (egocentric-word-is-keyword-1 word egocentric-regexp-list))) + + +(defun egocentric-word-is-keyword-1 (word list) + "''Recursor'' for `egocentric-word-is-keyword'. +Argument WORD is passed from caller. +Argument LIST is the list of keywords to compare against." + (cond + ((null list) nil) + ((not (null (string-match (car list) word)))) + ((egocentric-word-is-keyword-1 word (cdr list))))) + + +(defun egocentric-highlight-word (&optional pos) + "Actually build and put a cute overlay at POS (defaulted to point)." + (save-excursion + (when (not (equal pos (point))) + (goto-char pos)) + (let ((begin (re-search-backward "\\<" nil t)) + (end (re-search-forward "\\>" nil t))) + (if (not (egocentric-overlay-at begin)) + (let ((ovr (make-overlay begin end nil t nil))) + (setq egocentric-overlay-list (cons ovr egocentric-overlay-list)) + (overlay-put ovr 'face 'egocentric-face)) + (if (not (egocentric-overlay-at end)) + (move-overlay (egocentric-overlay-at begin) begin end)))))) + + +(defun egocentric-overlay-at (&optional pos) + "Return true when there is already an egocentric overlay at POS (defaulted to point)." + (let ((overlays-at-point (overlays-at (or pos (point))))) + (if (not (null overlays-at-point)) + (egocentric-overlay-at-1 overlays-at-point)))) + + +(defun egocentric-overlay-at-1 (overlay-list) + "''Recursor'' of `egocentric-overlay-at'. +Argument OVERLAY-LIST is the list of overlays at POS as passed by `egocentric-overlay-at'." + (cond + ((null overlay-list) nil) + ((egocentric-overlay-p (car overlay-list)) (car overlay-list)) + ((egocentric-overlay-at-1 (cdr overlay-list))))) + + +(defun egocentric-overlay-p (overlay) + "Return true when OVERLAY is an egocentric overlay." + (if (memq overlay egocentric-overlay-list) t)) + + +(defun egocentric-unhighlight-at (&optional pos) + "Remove egocentric overlays at POS (defaulted to point)." + (let ((overlays (overlays-at (or pos (point))))) + (while (consp overlays) + (if (egocentric-overlay-p (car overlays)) + (delete-overlay (car overlays))) + (setq overlays (cdr overlays))))) + + +(defun egocentric-insinuate (regexp-list) + "Highlight egocentric keywords present in that buffer. +Argument REGEXP-LIST is the list of regexps to use." + (if (null regexp-list) + nil + (progn + (save-excursion + (beginning-of-buffer) + (while (re-search-forward (car regexp-list) nil t) + (egocentric-highlight-word (1+ (match-beginning 0))))) + (egocentric-insinuate (cdr regexp-list))))) + + +(defun egocentric-delete-all-overlays () + "Delete all egocentric overlays." + (let ((l (overlays-in (point-min) (point-max)))) + (while (consp l) + (progn + (if (egocentric-overlay-p (car l)) + (delete-overlay (car l))) + (setq l (cdr l)))))) + +;;; egocentric.el ends here diff --git a/elisp/emacs-goodies-el/emacs-goodies-build.el b/elisp/emacs-goodies-el/emacs-goodies-build.el new file mode 100755 index 0000000..248e5bc --- /dev/null +++ b/elisp/emacs-goodies-el/emacs-goodies-build.el @@ -0,0 +1,169 @@ +;;; emacs-goodies-build.el --- emacs-goodies-el maintance code +;; Copyright (C) 2003 Peter S. Galbraith + +;; This package 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 package 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: +;; +;; A few very rough functions to help with the maintenance of the +;; emacs-goodies-el pacakge. None of this is meant for everyday use. +;; +;; I created `insert-missing-autoloads' to see what files didn't have +;; `;;;###autoload' markers for autoloads in emacs-goodies-el.el. +;; +;; Then I created `delete-tagged-autoloads' the remove a bunch of autoloads +;; that were entered manually in emacs-goodies-el.el since they can be +;; automatically generated. +;; +;; `insert-defgroup' and `insert-defgroup-dired' are used to automatically +;; make the file `emacs-goodies-custom.el' which loads a modified version +;; of all `defgroup' declarations from all files. Go into dired for this +;; directory and run `insert-defgroup-dired' from the line before the first +;; listed file. It will generate a buffer with `emacs-goodies-custom.el' +;; from all files. +;; +;; `document-tagged-autoloads' extracts a texinfo table from autoload +;; tagged commands. I should probably make sure they are interactive. + +;; Kevin Ryde writes: +;; Incidentally, I believe an ;;;###autoload cookie on a defgroup copies +;; it into the loaddefs, if that's easier to maintain, esp if respective +;; authors were persuaded to put it in upstream. That'd just leave +;; emacs-goodies-el.info doc links perhaps done by custom-add-link. + +;;; History: +;; + +;;; Code: +(defun insert-missing-autoloads () + "Scan emacs-goodies-el.el for autoloads and check if there are in files." + (interactive) + (while (re-search-forward "(autoload '\\([^ ]+\\) \"\\(.*\\)\"" nil t) + (let* ((command (match-string-no-properties 1)) + (efile (concat (match-string-no-properties 2) ".el"))) + (save-excursion + (find-file efile) + (goto-char (point-min)) + (when (re-search-forward (concat "^(defun " command "[ (]") nil t) + (forward-line -1) + (when (not (looking-at "^;;;###autoload")) + (end-of-line) + (insert "\n;;;###autoload") + (message "Inserted for %s in %s" command efile) + (save-buffer))))))) + +(defun delete-tagged-autoloads () + "Scan emacs-goodies-el.el for autoloads and delete those that are marked. +Those that already have a ;;###autoload marker string are deleted from +emacs-goodies-el.el because a autoload file is automatically generated +(i.e. emacs-goodies-loaddefs.el)." + (interactive) + (while (re-search-forward "(autoload '\\([^ ]+\\) \"\\(.*\\)\"" nil t) + (let* ((start (match-beginning 0)) + (command (match-string-no-properties 1)) + (efile (concat (match-string-no-properties 2) ".el")) + (deleteit)) +;; (the-buffer (create-file-buffer efile))) + (save-excursion +;; (set-buffer the-buffer) +;; (insert-file-contents efile) + (find-file efile) + (goto-char (point-min)) + (when (re-search-forward (concat "^(defun " command "[ (]") nil t) + (forward-line -1) + (when (looking-at "^;;;###autoload") + (setq deleteit t)))) + (when deleteit + (goto-char start) + (forward-sexp 1) + (forward-line 1) + (delete-region start (point)) + (message "***Deleting %s in %s" command efile))))) + +(defun insert-defgroup () + "Scan buffer for defgroup statements and merge in emacs-goodies-custom.el. +Add a :link ' +Add a :group 'emacs-goodies-el" + (interactive) + (save-excursion + (when (re-search-forward "^(defgroup \\([^ ]+\\)" nil t) + (beginning-of-line) + (let ((filename (file-name-nondirectory (buffer-file-name))) + (defname (match-string 1)) + (text (buffer-substring (point)(progn (forward-sexp 1)(point))))) + (if (string-match "^\\(.*\\)\\.el$" filename) + (setq filename (match-string 1 filename))) + (find-file "emacs-goodies-custom.el") + (goto-char (point-max)) + (narrow-to-region (point)(point)) + (insert (format ";; %s\n" filename)) + (insert text) + (delete-backward-char 1) + (insert (format "\n;;:link '(custom-manual \"(emacs-goodies-el)%s\")\n" + filename)) + (insert (format " :load '%s\n" filename)) +;; (insert (format " :require '%s\n" filename)) + (insert " :group 'emacs-goodies-el)\n\n") + (widen) + (save-buffer))))) + +(defun insert-defgroup-dired () + "Run through list of elisp files in dired." + (interactive) + (while (= 0 (forward-line 1)) + (when (and (looking-at ".*el$") + (not (looking-at ".*emacs-goodies-el.el$")) + (not (looking-at ".*emacs-goodies-custom.el$"))) + (save-excursion + (dired-find-file) + (goto-char (point-min)) + (emacs-lisp-mode) + (insert-defgroup)))) + (find-file "emacs-goodies-custom.el") + (goto-char (point-min)) + (insert ";;; emacs-goodies-custom.el --- Automatically harvested defgroups\n") + (insert ";;\n") + (insert ";; Peter S Galbraith \n") + (insert ";; License of copied code applies to this combined work (GPL V2)\n") + (insert ";;\n") + (insert ";;; Code:\n\n") + (goto-char (point-max)) + (insert "(provide 'emacs-goodies-custom)\n")) + +(defun document-tagged-autoloads () + "Scan for autoloads and extract texinfo doc string." + (interactive) + (let ((entries "")(function)(string)) + (while (re-search-forward "^;;;###autoload" nil t) + (forward-line 1) + (when (looking-at "^(defun \\(.+\\) (") + (setq function (match-string-no-properties 1)) + (forward-line 1) + (if (or (looking-at " \"\\(.*\\)\"$") + (looking-at " \"\\(.*\\)$")) + (setq string (match-string-no-properties 1)) + (setq string "")) + (setq entries (concat entries "@item " function "\n" string "\n")))) + (setq entries (concat "@noindent Commands:\n\n@table @samp\n" + entries "@end table\n")) + (with-output-to-temp-buffer "*Help*" + (princ entries)))) + +(provide 'emacs-goodies-build) + +;;; emacs-goodies-build.el ends here diff --git a/elisp/emacs-goodies-el/emacs-goodies-custom.el b/elisp/emacs-goodies-el/emacs-goodies-custom.el new file mode 100755 index 0000000..c902385 --- /dev/null +++ b/elisp/emacs-goodies-el/emacs-goodies-custom.el @@ -0,0 +1,570 @@ +;;; emacs-goodies-custom.el --- Automatically harvested defgroups +;; +;; Peter S Galbraith +;; License of copied code applies to this combined work (GPL V2) +;; +;;; Code: + +(defgroup apache-mode nil + "Major mode for editing Apache configuration files." + :group 'programming + :link '(custom-manual "(emacs-goodies-el)apache-mode") + :load 'apache-mode +;;:require 'apache-mode + :group 'emacs-goodies-el) + +(defgroup ascii nil + "ASCII code display" + :link '(emacs-library-link :tag "Source Lisp File" "ascii.el") + :prefix "ascii-" + :group 'data + :link '(custom-manual "(emacs-goodies-el)ascii") + :load 'ascii + :group 'emacs-goodies-el) + +;; auto-fill-inhibit.el +(defgroup auto-fill-inhibit '((auto-fill-inhibit-list custom-variable)) + "Finer grained control over auto-fill-mode (de)activation." + :load 'auto-fill-inhibit + :link '(custom-manual "(emacs-goodies-el)auto-fill-inhibit") + :group 'emacs-goodies-el) + +;; bar-cursor +(defgroup bar-cursor nil + "switch block cursor to a bar." + :link '(custom-manual "(emacs-goodies-el)bar-cursor") + :group 'convenience + :load 'bar-cursor +;;:require 'bar-cursor + :group 'emacs-goodies-el) + +(defgroup bm nil + "Visible, buffer local bookmarks." + :link '(emacs-library-link :tag "Source Lisp File" "bm.el") + :group 'faces + :group 'editing + :prefix "bm-" + :link '(custom-manual "(emacs-goodies-el)bm") + :load 'bm + :group 'emacs-goodies-el) + +;; boxquote +(defgroup boxquote nil + "Mark regions of text with a half-box." + :group 'editing + :prefix "boxquote-" + :link '(custom-manual "(emacs-goodies-el)boxquote") + :load 'boxquote +;;:require 'boxquote + :group 'emacs-goodies-el) + +;; browse-kill-ring +(defgroup browse-kill-ring nil + "A package for browsing and inserting the items in `kill-ring'." + :link '(url-link "http://web.verbum.org/~walters") + :group 'convenience + :link '(custom-manual "(emacs-goodies-el)browse-kill-ring") + :load 'browse-kill-ring +;;:require 'browse-kill-ring + :group 'emacs-goodies-el) + +;; color-theme +(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 + :link '(custom-manual "(emacs-goodies-el)color-theme") + :load 'color-theme_seldefcustom + :group 'emacs-goodies-el) + +;; csv-mode +(defgroup CSV nil + "Major mode for editing files of comma-separated value type." + :group 'convenience + :link '(custom-manual "(emacs-goodies-el)csv-mode") + :load 'csv-mode + :group 'emacs-goodies-el) + +;; ctypes +(defgroup ctypes nil + "Enhanced Font lock support for custom defined types." + :group 'programming + :link '(custom-manual "(emacs-goodies-el)ctypes") + :load 'ctypes + :group 'emacs-goodies-el) + +;; df +(defgroup df nil + "Display space left on partitions in the mode-line." + :group 'convenience + :link '(custom-manual "(emacs-goodies-el)df") + :load 'df +;;:require 'df + :group 'emacs-goodies-el) + +;; diminish +(defgroup diminish nil + "Diminished modes are minor modes with no modeline display." + :group 'convenience + :link '(custom-manual "(emacs-goodies-el)diminish") + :load 'diminish +;;:require 'diminish + :group 'emacs-goodies-el) + +;; dir-locals +(defgroup dir-locals () + "Directory-wide file-local variables" + :link '(emacs-commentary-link "dir-locals") + :group 'files + :link '(custom-manual "(emacs-goodies-el)dir-locals") + :load 'dir-locals + :group 'emacs-goodies-el) + +;; egocentric +(defgroup egocentric nil + "Highlight your name in arbitrary buffers." + :group 'files + :group 'convenience + :link '(custom-manual "(emacs-goodies-el)egocentric") + :load 'egocentric +;;:require 'egocentric + :group 'emacs-goodies-el) + +;; eproject +(defgroup eproject nil + "Eproject; provide support for grouping files and buffers into projects" + :prefix "eproject-" + :group 'convenience + :link '(emacs-commentary-link :tag "Commentary" "eproject.el") + :link '(emacs-library-link :tag "Optional extras" "eproject-extras.el") + :link '(url-link :tag "Github wiki" "http://wiki.github.com/jrockway/eproject") + :load 'eproject + :group 'emacs-goodies-el) + +;; ff-paths +(defgroup ff-paths nil + "Find file using paths." + :group 'ffap + :group 'matching + :group 'convenience + :link '(custom-manual "(emacs-goodies-el)ff-paths") + :load 'ff-paths +;;:require 'ff-paths + :group 'emacs-goodies-el) + +;; filladapt +(defgroup filladapt nil + "Enhanced filling" + :group 'fill + :link '(custom-manual "(emacs-goodies-el)filladapt") + :load 'filladapt +;;:require 'filladapt + :group 'emacs-goodies-el) + +;; floatbg +(defgroup floatbg nil + "Slowly modify background color by moving through an HSV color model." + :tag "Floating Background" + :group 'frames + :prefix "floatbg-" + :link '(custom-manual "(emacs-goodies-el)floatbg") + :load 'floatbg +;;:require 'floatbg + :group 'emacs-goodies-el) + +;; folding +(defgroup folding nil + "Managing buffers with Folds." + :group 'tools + :link '(custom-manual "(emacs-goodies-el)folding") + :load 'folding +;;:require 'folding + :group 'emacs-goodies-el) + +;; framepop +(defgroup framepop nil + "Display temporary buffers in a dedicated frame." + :group 'frames + :link '(custom-manual "(emacs-goodies-el)framepop") + :load 'framepop +;;:require 'framepop + :group 'emacs-goodies-el) + +;; graphviz-dot-mode.el +(defgroup graphviz nil + "Major mode for editing Graphviz Dot files" + :group 'tools + :link '(custom-manual "(emacs-goodies-el)graphviz-dot-mode") + :load 'graphviz-dot-mode + :group 'emacs-goodies-el) + +;; highlight-beyond-fill-column +(defgroup highlight-beyond-fill-column nil + "Fontify beyond the fill-column." + :group 'fill + :link '(custom-manual "(emacs-goodies-el)highlight-beyond-fill-column") + :load 'highlight-beyond-fill-column +;;:require 'highlight-beyond-fill-column + :group 'emacs-goodies-el) + +;; highlight-completion +(defgroup highlight-completion nil + "Highlight completion mode: display completion as highlighted text." + :tag "Highlight completion" + :prefix "hc" + :link '(url-link :tag "Home Page" "http://www.math.washington.edu/~palmieri/Emacs/hlc.html") + :group 'abbrev + :link '(custom-manual "(emacs-goodies-el)highlight-completion") + :load 'highlight-completion +;;:require 'highlight-completion + :group 'emacs-goodies-el) + +;; highlight-current-line +(defgroup highlight-current-line nil + "Highlight line where the cursor is." + :load 'highlight-current-line + :group 'faces + :link '(custom-manual "(emacs-goodies-el)highlight-current-line") + :load 'highlight-current-line +;;:require 'highlight-current-line + :group 'emacs-goodies-el) + +;; htmlize +(defgroup htmlize nil + "HTMLize font-locked buffers." + :group 'hypermedia + :link '(custom-manual "(emacs-goodies-el)htmlize") + :load 'htmlize +;;:require 'htmlize + :group 'emacs-goodies-el) + +;; initsplit +(defgroup initsplit nil + "Code to split customizations into different files." + :group 'initialization +;;:link '(custom-manual "(emacs-goodies-el)initsplit") + :load 'initsplit +;;:require 'initsplit + :group 'emacs-goodies-el) + +(defgroup joc-toggle-buffer nil + "toggle-buffer package customization" + :group 'tools + :link '(custom-manual "(emacs-goodies-el)joc-toggle-buffer") + :load 'joc-toggle-buffer + :group 'emacs-goodies-el) + +(defgroup joc-toggle-case nil + "joc-toggle-case package customization" + :group 'tools + :link '(custom-manual "(emacs-goodies-el)joc-toggle-case") + :load 'joc-toggle-case + :group 'emacs-goodies-el) + +;; keywiz +(defgroup keywiz nil + "Emacs key sequence quiz." + :version "21.2" + :group 'games + :group 'keyboard + :link '(emacs-commentary-link "keywiz.el") + :link '(custom-manual "(emacs-goodies-el)keywiz") + :load 'keywiz +;;:require 'keywiz + :group 'emacs-goodies-el) + +;; lcomp +(defgroup lcomp nil + "list-completion hacks." + :group 'completion + :link '(custom-manual "(emacs-goodies-el)lcomp") + :load 'lcomp + :group 'emacs-goodies-el) + +;; maplev +(defgroup maplev nil + "Major mode for editing Maple source in Emacs" + :group 'languages + :link '(custom-manual "(emacs-goodies-el)maplev") + :load 'maplev + :group 'emacs-goodies-el) + +;; matlab +(defgroup matlab nil + "Matlab mode." + :prefix "matlab-" + :group 'languages + :link '(custom-manual "(emacs-goodies-el)matlab") + :load 'matlab + :group 'emacs-goodies-el) + +;; minibuffer-complete-cycle +(defgroup minibuffer-complete-cycle nil + "Cycle through the *Completions* buffer." + :group 'completion + :link '(custom-manual "(emacs-goodies-el)minibuffer-complete-cycle") + :load 'minibuffer-complete-cycle +;;:require 'minibuffer-complete-cycle + :group 'emacs-goodies-el) + +(defgroup miniedit nil + "Miniedit" + :group 'applications + :link '(custom-manual "(emacs-goodies-el)miniedit") + :load 'miniedit +;;:require 'miniedit + :group 'emacs-goodies-el) + +(defcustom miniedit-install-p nil + "Whether to setup miniedit for use." + :type 'boolean + :set (lambda (symbol value) + (set-default symbol value) + (when value + (if (string-match "XEmacs" emacs-version) + (miniedit-install-for-xemacs) + (miniedit-install)))) + :require 'miniedit + :group 'miniedit) + +;; mutt-alias +(defgroup mutt-alias nil + "Lookup mutt mail aliases." + :group 'mail + :prefix "mutt-alias-" + :link '(custom-manual "(emacs-goodies-el)mutt-alias") + :load 'mutt-alias +;;:require 'mutt-alias + :group 'emacs-goodies-el) + +;; muttrc-mode +(defgroup muttrc nil + "Muttrc editing commands for Emacs." + :group 'files + :prefix "muttrc-" + :link '(custom-manual "(emacs-goodies-el)muttrc-mode") + :load 'muttrc-mode +;;:require 'muttrc-mode + :group 'emacs-goodies-el) + +;; pack-windows +(defgroup pack-windows nil + "Resize all windows to display as much info as possible." + :group 'convenience + :link '(custom-manual "(emacs-goodies-el)pack-windows") + :load 'pack-windows + :group 'emacs-goodies-el) + +;; perldoc +(defgroup perldoc nil + "Show help for Perl functions, builtins, and modules." + :group 'help + :link '(custom-manual "(emacs-goodies-el)perldoc") + :load 'perldoc +;;:require 'perldoc + :group 'emacs-goodies-el) + +;; pp-c-l.el +(defgroup Pretty-Control-L nil + "Options to define pretty display of Control-l (`^L') characters." + :prefix "pp^L-" :group 'convenience :group 'wp + :link `(url-link :tag "Send Bug Report" + ,(concat "mailto:" "drew.adams" "@" "oracle" ".com?subject=pp-c-l.el bug: \ +&body=Describe bug here, starting with `emacs -q'. \ +Don't forget to mention your Emacs and library versions.")) + :link '(url-link :tag "Other Libraries by Drew" + "http://www.emacswiki.org/cgi-bin/wiki/DrewsElispLibraries") + :link '(url-link :tag "Download" "http://www.emacswiki.org/cgi-bin/wiki/pp-c-l.el") + :link '(url-link :tag "Description" + "http://www.emacswiki.org/cgi-bin/wiki/PrettyControlL") + :link '(emacs-commentary-link :tag "Commentary" "pp-c-l") + :link '(custom-manual "(emacs-goodies-el)pp-c-l") + :load 'pp-c-l + :group 'emacs-goodies-el) + +;; projects +(defgroup projects nil + "Project-based buffer name management." + :group 'convenience + :link '(custom-manual "(emacs-goodies-el)projects") + :load 'projects +;;:require 'projects + :group 'emacs-goodies-el) + +;; protbuf +(defgroup protect-buffer nil + "Protect buffers from accidental killing." + :group 'killing + :link '(custom-manual "(emacs-goodies-el)protbuf") + :load 'protbuf +;;:require 'protbuf + :group 'emacs-goodies-el) + +;; quack +(defgroup quack nil + "Enhanced support for editing and running Scheme code." + :group 'scheme + :prefix "quack-" + :link '(url-link "http://www.neilvandyke.org/quack/") + :load 'quack + :link '(custom-manual "(emacs-goodies-el)quack") + :group 'emacs-goodies-el) + +(defcustom quack-install nil + "Whether to setup quack for use." + :type 'boolean + :set (lambda (symbol value) + (set-default symbol value) + (when value + (quack-install))) + :require 'quack + :group 'quack) + +;; rfcview +(defgroup rfcview nil + "View IETF RFC files with formatting." + :group 'hypermedia + :prefix "rfcview-" + :link '(custom-manual "(emacs-goodies-el)rfcview") + :load 'rfcview + :group 'emacs-goodies-el) + +;; session +(defgroup session nil + "Use variables, registers and buffer places across sessions." + :group 'data + :link '(emacs-commentary-link "session.el") + :link '(url-link "http://emacs-session.sourceforge.net/") + :prefix "session-" + :link '(custom-manual "(emacs-goodies-el)session") + :load 'session +;;:require 'session + :group 'emacs-goodies-el) + +;; setnu +(defgroup setnu nil + "vi-style line number mode for Emacs." + :link '(custom-manual "(emacs-goodies-el)setnu") + :load 'setnu + :group 'emacs-goodies-el) + +;; shell-command +(defgroup shell-command nil + "Enable Tab completions for `shell-command' and related commands." + :group 'shell + :link '(custom-manual "(emacs-goodies-el)shell-command") + :load 'shell-command + :group 'emacs-goodies-el) + +;; show-wspace +(defgroup Show-Whitespace nil + "Highlight whitespace of various kinds." + :prefix "show-ws-" + :group 'convenience :group 'matching + :link `(url-link :tag "Send Bug Report" + ,(concat "mailto:" "drew.adams" "@" "oracle" ".com?subject=\ +show-wspace.el bug: \ +&body=Describe bug here, starting with `emacs -q'. \ +Don't forget to mention your Emacs and library versions.")) + :link '(url-link :tag "Other Libraries by Drew" + "http://www.emacswiki.org/cgi-bin/wiki/DrewsElispLibraries") + :link '(url-link :tag "Download" + "http://www.emacswiki.org/cgi-bin/wiki/show-wspace.el") + :link '(url-link :tag "Description" + "http://www.emacswiki.org/cgi-bin/wiki/ShowWhiteSpace#ShowWspace") + :link '(emacs-commentary-link :tag "Commentary" "show-wspace") + :load 'show-wspace + :group 'emacs-goodies-el + ) + +;; slang-mode +(defgroup slang nil + "Major mode for editing slang code." + :prefix "slang-" + :group 'languages + :link '(custom-manual "(emacs-goodies-el)slang-mode") + :load 'slang-mode + :group 'emacs-goodies-el) + +(defgroup silly-mail nil + "Generate bozotic mail headers." + :group 'mail + :group 'mh + :group 'sendmail + :link '(custom-manual "(emacs-goodies-el)silly-mail") + :load 'silly-mail + :group 'emacs-goodies-el) + +(defgroup tabbar nil + "Display a tab bar in the header line." + :group 'convenience + :link '(custom-manual "(emacs-goodies-el)tabbar") + :load 'tabbar + :group 'emacs-goodies-el) + +;; tail +(defgroup tail nil + "Tail files or commands into Emacs buffers." + :prefix "tail-" + :group 'environment + :link '(custom-manual "(emacs-goodies-el)tail") + :load 'tail +;;:require 'tail + :group 'emacs-goodies-el) + +;; tc +(defgroup tc nil "Insert cited text in a nice manner" +;;:link '(custom-manual "(emacs-goodies-el)tc") + :load 'tc +;;:require 'tc + :group 'emacs-goodies-el) + +;; thinks +(defgroup thinks nil + "Insert text in a think bubble." + :group 'editing + :prefix "thinks-" + :link '(custom-manual "(emacs-goodies-el)thinks") + :load 'thinks +;;:require 'thinks + :group 'emacs-goodies-el) + +;;tlc +(defgroup tlc nil + "Major mode for editing tlc files." + :group 'languages + :link '(custom-manual "(emacs-goodies-el)tlc") + :load 'tlc + :group 'emacs-goodies-el) + +;; todoo +(when (not (featurep 'xemacs)) + (defgroup todoo nil + "Maintain a list of todo items." + :group 'calendar + :link '(custom-manual "(emacs-goodies-el)todoo") + :load 'todoo + ;;:require 'todoo + :group 'emacs-goodies-el)) + +;; toggle-option +(defgroup toggle-option nil + "Convenience library for toggling commonly toggled variables/functions." + :group 'convenience + :link '(custom-manual "(emacs-goodies-el)toggle-option") + :load 'toggle-option +;;:require 'toggle-option + :group 'emacs-goodies-el) + +;; xrdb-mode +(defgroup xrdb nil + "Support for editing X resource database files" + :group 'languages + :link '(custom-manual "(emacs-goodies-el)xrdb-mode") + :load 'xrdb-mode +;;:require 'xrdb-mode + :group 'emacs-goodies-el) + +(provide 'emacs-goodies-custom) diff --git a/elisp/emacs-goodies-el/emacs-goodies-el.el b/elisp/emacs-goodies-el/emacs-goodies-el.el new file mode 100755 index 0000000..2df98f1 --- /dev/null +++ b/elisp/emacs-goodies-el/emacs-goodies-el.el @@ -0,0 +1,307 @@ +;;; emacs-goodies-el.el --- startup file for the emacs-goodies-el package + +;;; Commentary: +;; +;; This file is loaded from /etc/emacs/site-start.d/50emacs-goodies-el.el + +;;; History: +;; +;; 2009-02-22 Peter Galbraith +;; - Replace $ by \\' in auto-mode-alist entries (Closes: #570293) +;; 2006-11-26 - Ramkumar R. +;; - Obey `emacs-goodies-el-defaults' for xrdb-mode. +;; 2003-06-14 - Peter Galbraith +;; - Delete autoloads that can be generated automatically. +;; 2003-05-14 - Peter Galbraith +;; - Created from 50emacs-goodies-el.el contents. + +;;; Code: + +(defgroup emacs-goodies-el nil + "Debian emacs-goodies-el package customization." + :group 'convenience) + +(require 'emacs-goodies-loaddefs) +(require 'emacs-goodies-custom) + +(defcustom emacs-goodies-el-defaults nil + "Whether default settings are chosen conservatively or aggressively. +non-nil means aggressive. +Setting to aggressive will enable features that supercede Emacs defaults." + :type '(radio (const :tag "conservative" nil) + (const :tag "aggressive" t)) + :link '(custom-manual "(emacs-goodies-el)Top") + :group 'emacs-goodies-el) + +;; align-string.el +(autoload 'align-string "align-string" + "Align first occurrence of REGEXP in each line of region." + t) +(autoload 'align-all-strings "align-string" + "Align all occurrences of REGEXP in each line of region." + t) + +;; apache-mode.el +(add-to-list 'auto-mode-alist '("apache2\\.conf\\'" . apache-mode)) + +;; clipper.el +(autoload 'clipper-create "clipper" "Create a new 'clip' for use within Emacs." + t) +(autoload 'clipper-delete "clipper" "Delete an existing 'clip'." t) +(autoload 'clipper-insert "clipper" + "Insert a new 'clip' into the current buffer." + t) +(autoload 'clipper-edit-clip "clipper" "Edit an existing 'clip'." t) + +;; cvs-mode.el +(add-to-list 'auto-mode-alist '("\\.[Cc][Ss][Vv]\\'" . csv-mode)) +(autoload 'csv-mode "csv-mode" + "Major mode for editing comma-separated value files." t) + +;; ff-paths.el +(defcustom ff-paths-install emacs-goodies-el-defaults + "Whether to setup ff-paths for use. +find-file-using-paths searches certain paths to find files." + :type 'boolean + :set (lambda (symbol value) + (set-default symbol value) + (when value + (ff-paths-install))) + :load 'ff-paths +;; :require 'ff-paths + :group 'emacs-goodies-el + :group 'ff-paths) + +(defcustom ff-paths-use-ffap emacs-goodies-el-defaults + "Whether to setup ffap for use. + +Usually packages don't advertise or try to setup other packages, but +ff-paths works well in combination with ffap (Find FILENAME, guessing a +default from text around point) and so I recommend it here. + +find-file-using-paths searches certain paths to find files." + :type 'boolean + :set (lambda (symbol value) + (set-default symbol value) + (when value + (require 'ffap) + (ff-paths-in-ffap-install))) +;; :require 'ff-paths + :load 'ff-paths + :group 'emacs-goodies-el + :group 'ff-paths) + +;; filladapt +(autoload 'turn-on-filladapt-mode "filladapt" + "Unconditionally turn on Filladapt mode in the current buffer." + t) + +(defcustom filladapt-turn-on-mode-hooks nil + "*List of hooks for which to turn-on filladapt. +Filladapt works well with any language that uses comments that +start with some character sequence and terminate at end of line. +So it is good for Postscript, Lisp, Perl, C++ and shell modes. +It's not good for C mode because C's comments are multiline." + :type '(set (const text-mode-hook) + (const awk-mode-hook) + (const lisp-mode-hook) + (const emacs-lisp-mode-hook) + (const perl-mode-hook)) + :set (lambda (symbol value) + ;; Remove old values since user may have deleted entries + (if (and (boundp 'filladapt-mode-hooks) filladapt-mode-hooks) + (mapcar (lambda (hook) (remove-hook hook 'turn-on-filladapt-mode)) + filladapt-mode-hooks)) + (set-default symbol value) + ;; Set entries selected by the user. + (mapcar (lambda (hook) (add-hook hook 'turn-on-filladapt-mode)) + value)) + :load 'filladapt + :group 'emacs-goodies-el + :group 'filladapt) + +;; highlight-completion.el +(autoload 'highlight-completion-mode "highlight-completion" + "Activate highlight-completion." + t) + +;; highlight-current-line.el - compatibility +(autoload 'highlight-current-line-on "highlight-current-line" + "Switch highlighting of cursor-line on/off globally." + t) + +;; home-end.el +(defvar home-end-end-enable nil + "Whether `home-end-enable' was activated. +Stores the value of the prior `end' keybinding.") +(defvar home-end-home-enable nil + "Whether `home-end-enable' was activated. +Stores the value of the prior `home' keybinding.") +(defcustom home-end-enable emacs-goodies-el-defaults + "*Define [home] and [end] keys to act differently when hit 1, 2 or 3 times." + :type 'boolean + :set (lambda (symbol value) + (set-default symbol value) + (cond + (value + (setq home-end-end-enable (key-binding [end]) + home-end-home-enable (key-binding [home])) + (global-set-key [end] 'home-end-end) + (global-set-key [home] 'home-end-home)) + (t + (if home-end-end-enable + (global-set-key [end] home-end-end-enable)) + (if home-end-home-enable + (global-set-key [home] home-end-home-enable))))) + :load 'home-end + :group 'emacs-goodies-el) + +;; keydef.el +(autoload 'keydef "keydef" + "Define the key sequence SEQ, written in kbd form, to run CMD." + t) + +;; keywiz.el +(autoload 'keywiz "keywiz" + "Start a key sequence quiz." + t) + +;; map-lines.el +(autoload 'map-lines "map-lines" + "Map COMMAND over lines matching REGEX." + t) + +;; maplev +(autoload 'maplev-mode "maplev" "Maple editing mode" t) +(autoload 'cmaple "maplev" "Start maple process" t) +(add-to-list 'auto-mode-alist '("\\.mpl\\'" . maplev-mode)) + +;; matlab +(defcustom matlab-auto-mode nil + "*Enter matlab-mode when editing .m files. +Technically, this adjusts the `auto-mode-list' when set. +To unset, you will have to restart Emacs." + :type 'boolean + :set (lambda (symbol value) + (set-default symbol value) + (cond + (value + (add-to-list 'auto-mode-alist '("\\.m\\'" . matlab-mode))))) + :load 'matlab + :group 'emacs-goodies-el + :require 'matlab) + +;; minibuf-electric.el +(defcustom minibuffer-electric-file-name-behavior nil + "*If non-nil, slash and tilde in certain places cause immediate deletion. +These are the same places where this behavior would occur later on anyway, +in `substitute-in-file-name'." + :type 'boolean + :require 'minibuf-electric + :load 'minibuf-electric + :group 'emacs-goodies-el + :group 'minibuffer) + +;; mutt-alias.el +(autoload 'mutt-alias-insert "mutt-alias" + "Insert the expansion for ALIAS into the current buffer." + t) +(autoload 'mutt-alias-lookup "mutt-alias" + "Lookup and display the expansion for ALIAS." + t) + +;; muttrc-mode.el +(add-to-list 'auto-mode-alist '("muttrc\\'" . muttrc-mode)) + + +;; pod-mode.el +(add-to-list 'auto-mode-alist '("\\.pod\\'" . pod-mode)) + +;; rfcview +(add-to-list 'auto-mode-alist + '("/rfc[0-9]+\\.txt\\(\\.gz\\)?\\'" . rfcview-mode)) + +;; session.el +(autoload 'session-initialize "session" + "Initialize package session and read previous session file. +Setup hooks and load `session-save-file', see `session-initialize'. At +best, this function is called at the end of the Emacs startup, i.e., add +this function to `after-init-hook'." + t) + +;; setnu.el +(autoload 'setnu-mode "setnu" + "Toggle setnu-mode." + t) +(autoload 'turn-on-setnu-mode "setnu" + "Turn on setnu-mode." + nil) + +;; slang-mode.el +(setq auto-mode-alist + (append '(("\\.sl\\'" . slang-mode)) auto-mode-alist)) + +;; todoo.el +(when (not (featurep 'xemacs)) + (autoload 'todoo "todoo" + "TODO Mode." + t) + (autoload 'todoo-mode "todoo" + "TODO Mode" + t) + (add-to-list 'auto-mode-alist '("TODO\\'" . todoo-mode))) + +;; toggle-option.el +(autoload 'toggle-option "toggle-option" + "Easily toggle frequently toggled options." + t) + +;; upstart-mode.el +(when (not (featurep 'xemacs)) + (autoload 'upstart-mode "upstart-mode" + "major mode for .upstart files." + t) + (add-to-list 'auto-mode-alist '("\\.upstart\\'" . upstart-mode))) + +;; xrdb-mode.el + +(defun xrdb-mode-setup-auto-mode-alist () + (add-to-list 'auto-mode-alist '("\\.Xdefaults\\'" . xrdb-mode)) + (add-to-list 'auto-mode-alist '("\\.Xenvironment\\'". xrdb-mode)) + (add-to-list 'auto-mode-alist '("\\.Xresources\\'". xrdb-mode)) + (add-to-list 'auto-mode-alist '("\\.ad\\'". xrdb-mode)) + (add-to-list 'auto-mode-alist '("/app-defaults/". xrdb-mode)) + (add-to-list 'auto-mode-alist '("/Xresources/". xrdb-mode))) + +(defcustom xrdb-mode-setup-auto-mode-alist + (or + ;; Check if conf-xdefaults-mode is present + (not (fboundp 'conf-xdefaults-mode)) + ;; Check if default setup provides bindings for conf-xdefaults-mode + (< emacs-major-version 22) + (featurep 'xemacs) + ;; Check if the user wants settings to be clobbered + emacs-goodies-el-defaults) + "Whether to setup mode-alists for xrdb mode. + +Newer versions of Emacs have a conf-xdefaults-mode which provides +this functionality. `xrdb' still has some features (like +electricity) which are absent in that mode. Setting this to +non-nil clobbers the default bindings in such cases. + +This variable defaults to t for older emacsen and the value +`emacs-goodies-el-defaults' for newer ones. + +Customizing this variable might require restarting emacs for the +effects to take effect." + :type 'boolean + :set (lambda (symbol value) + (set-default symbol value) + (when value + (xrdb-mode-setup-auto-mode-alist))) + :group 'emacs-goodies-el + :group 'xrdb) + +(provide 'emacs-goodies-el) + +;;; emacs-goodies-el.el ends here diff --git a/elisp/emacs-goodies-el/emacs-goodies-el.texi b/elisp/emacs-goodies-el/emacs-goodies-el.texi new file mode 100644 index 0000000..e7ecaaa --- /dev/null +++ b/elisp/emacs-goodies-el/emacs-goodies-el.texi @@ -0,0 +1,4018 @@ +@c -*- mode: texinfo -*- +\input texinfo + +@c $Id: emacs-goodies-el.texi,v 1.104 2016/11/06 20:08:20 psg Exp $ +@c %**start of header +@setfilename info/emacs-goodies-el +@settitle Emacs-Goodies-el +@documentencoding ISO-8859-1 +@c %**end of header + +@dircategory Emacs +@direntry +* Emacs-Goodies-el: (emacs-goodies-el). Miscellaneous add-ons for Emacs +@end direntry + +@c Version variables. +@set EDITION 30.2 +@set UPDATED 25 Nov 2009 + +@ifinfo +This is Edition @value{EDITION}, last updated @value{UPDATED}, of +@cite{Emacs-Goodies-el}. +@end ifinfo + +@titlepage +@title Emacs-Goodies-el: Miscellaneous add-ons for Emacs +@subtitle A manual for what's in this package. +@author Peter S. Galbraith +@end titlepage + +@node Top, align-string, (dir), (dir) +@top The Emacs-Goodies-el Package Setup + +This manual describes the Emacs-Goodies-el package and its setup. A +quick descriptions of elisp files contained in this package can be found +in the file @file{/usr/share/doc/emacs-goodies-el/README.Debian.gz}. + +All packaged files are installed, setup and ready to use if they don't +override standard Emacs commands, modes, or settings. + +Some extra package installation and setup is done if you customize the +variable @code{emacs-goodies-el-defaults} to t (its aggressive state). +These will override standard Emacs defaults, but in a good +(uncontroversial) way. The affected packages are currently only +@ref{ff-paths} and @ref{home-end}. Packages which require activation in +order to function also include: @ref{bar-cursor}, @ref{diminish}, +@ref{df} and @ref{filladapt}. + +To customize setup of all customizable packages on a finer-grain +basis, do: +@example +@kbd{M-x} customize-group @key{RET} emacs-goodies-el @key{RET} +@end example + +In the following document, when we speak of customizing a variable, we +mean to use the Emacs custom interface, such as in: +@example +@kbd{M-x} customize-variable @key{RET} some-variable @key{RET} +@end example +When we speak of customizing a group, it's as the example above for the +group @code{emacs-goodies-el}. + +The following files are documented so far. Eventually, all files will +be documented. + +@menu +* align-string:: Align string components over several lines +* all:: Edit all lines matching a given regexp +* apache-mode:: Major mode for Apache configuration files +* auto-fill-inhibit:: auto-fill-mode (de)activation +* ascii:: ASCII code display for character under point +* bar-cursor:: Switch block cursor to a bar +* bm:: Visible bookmarks in buffers +* boxquote:: Quote text with a semi-box +* browse-huge-tar:: Browse files in a tarball memory-efficiently +* browse-kill-ring:: Interactively insert items from kill-ring +* clipper:: Save strings of data for further use +* coffee:: Submit BREW request to RFC2324-compliant device +* color-theme:: Install color themes +* csv-mode:: Mode for comma-separated value files. +* ctypes:: Enhanced font-lock for custom defined types +* dedicated:: Minor mode for dedicated buffers +* df:: Display space left on partitions in mode-line +* dict:: Emacs interface to dict client +* diminish:: Diminish minor-mode's display +* dir-locals:: Local variables for a directory tree +* edit-env:: Display and edit environment variables +* egocentric:: Highlight your name inside emacs buffers +* eproject:: Sssign files to projects, programatically +* ff-paths:: Searches certain paths to find files +* filladapt:: Adaptively set fill-prefix +* floatbg:: Slowly modify background color +* folding:: A folding-editor-like minor mode +* framepop:: Display temporary buffers in a dedicated frame +* graphviz-dot-mode:: Mode for the dot-language used by graphviz. +* highlight-beyond-fill-column:: Fontify beyond the fill-column +* highlight-completion:: Completion with highlighted provisional text +* highlight-current-line:: highlight line where the cursor is +* home-end:: Alternative Home and End key commands +* htmlize:: HTML-ize font-lock buffers +* joc-toggle-buffer:: Flips back and forth between two buffers +* joc-toggle-case:: Toggles case at point like ~ in vi +* keydef:: A simpler way to define keys, with kbd syntax +* keywiz:: Emacs key sequence quiz +* lcomp:: list-completion hacks +* maplev:: Maple major mode +* map-lines:: Map a command over many lines +* markdown-mode:: Major mode for editing Markdown files +* marker-visit:: Navigate through a buffer's marks in order +* matlab:: Major mode for MATLAB dot-m files +* minibuf-electric:: Electric minibuffer behavior from XEmacs +* minibuffer-complete-cycle:: Cycle through the *Completions* buffer +* miniedit:: Enhanced editing for minibuffer fields. +* mutt-alias:: Lookup/insert mutt mail aliases +* muttrc-mode:: Major mode to edit muttrc under Emacs +* obfusurl:: Obfuscate URLs so they aren't spoilers +* pack-windows:: Resize windows to display maximal information +* perldoc:: Show help for Perl functions and modules +* pp-c-l:: Display Control-l characters in a pretty way +* pod-mode:: Major mode for editing POD files +* projects:: Project-based buffer name management +* protbuf:: Protect buffers from accidental killing +* protocols:: Protocol database access functions +* quack:: Enhanced support for editing and running Scheme +* rfcview:: View IETF RFCs with improved formatting +* services:: Services database access functions +* session:: Session Management for Emacs +* setnu:: vi-style line number mode for Emacs +* shell-command:: Enables tab-completion for `shell-command' +* show-wspace:: Highlight whitespaces of various kinds +* slang-mode:: Major-mode for editing slang scripts +* silly-mail:: Generate bozotic mail headers +* sys-apropos:: Interface for the *nix apropos command +* tabbar:: Display a tab bar in the header line +* tail:: Tail files within Emacs +* tc:: Cite text with proper filling in mail +* tlc:: Major mode for editing tlc files +* thinks:: Insert text in a think bubble +* tld:: TLD (Top Level Domain) lookup tool +* todoo:: Major mode for editing TODO files +* toggle-option:: Easily toggle frequently toggled options +* twiddle:: Cute mode-line display hack +* under:: Underline with the ^ character +* upstart-mode:: Mode for editing upstart files +* xrdb-mode:: Mode for editing X resource database files + +@detailmenu + --- The Detailed Node Listing --- + +folding - A folding-editor-like minor mode. + +* folding Installation:: +* folding documentation:: +* folding custom:: +* folding examples:: + +framepop - display temporary buffers in a dedicated frame + +* announcement:: Announcement on gnu-emacs-sources +* Purpose:: What's it's for +* Quick Setup:: Get going within a minute +* Customization:: Extra settings +* For elisp hackers:: More extra seetings for teh adventurous +* Bugs:: Or limitations + +session - Session Management for Emacs + +* Session Menus and Key-Bindings:: +* Saving Session Variables:: +* Storing Buffer Places:: + +@end detailmenu +@end menu + +This work compiles GPL'ed documentation from the various elisp files +in /usr/share/emacs/site-lisp/emacs-goodies-el/. As a derived work +from GPL'ed works, this text is also licensed under the GPL V2 (See +/usr/share/common-licenses/GPL-2) and is edited by Peter S. Galbraith +@email{psg@@debian.org}. + +The following file is not yet documented. Read its commentary +section for usage, but be advised that I haven't documented it +because I intend to change it. + +@table @samp +@item /usr/share/emacs/site-lisp/emacs-goodies-el/initsplit.el +code to split customizations into different files +@end table + +@node align-string, all, Top, Top +@chapter align-string - align string components over several lines. + +This elisp file is not documented. The commands are: + +@table @samp +@item align-string + + Align first occurrence of REGEXP in each line of region. If given a +prefix argument, align occurrence number COUNT on each line. + +@item align-all-strings + + Align all occurrences of REGEXP in each line of region. That is to +say, align the first occurrence of each line with each other, align +the second occurence of each line with each other, and so on. +@end table + +@node all, apache-mode, align-string, Top +@chapter all - Edit all lines matching a given regexp. + +This is an implementation of the xedit @code{all} command for GNU Emacs. + +It works mostly like @code{occur} except that changes to the +@code{*All*} buffer are propagated back to the original buffer. + +Type @kbd{M-x all} to try it out. + +@node apache-mode, auto-fill-inhibit, all, Top +@chapter apache-mode - major mode for editing Apache configuration files + +@noindent Authors: Jonathan Marten , +Kevin A. Burton + +The mode provides fontification while editing Apache configuration +files. The list of keywords was derived from the documentation for +Apache 1.3; there may be some errors or omissions. + +There are currently no local keybindings defined, but the hooks are +there in the event that anyone gets around to adding any. + +@node auto-fill-inhibit, ascii, apache-mode, Top +@chapter auto-fill-inhibit - auto-fill-mode (de)activation + +@file{auto-fill-inhibit.el} suppresses @code{auto-fill-mode} in +buffers with names matching regexps in @code{auto-fill-inhibit-list}. +The idea is that you can have @code{turn-on-auto-fill} or similar in a +mode hook but then suppress certain names. For example, + +@example +(add-hook 'text-mode-hook 'turn-on-auto-fill) +(require 'auto-fill-inhibit) +(add-to-list 'auto-fill-inhibit-list "-blah\\.txt\\'") +@end example + +You can use @code{customize} for @code{auto-fill-inhibit-list}, +otherwise you must add @code{(require 'auto-fill-inhibit)} explicitly to +your @file{.emacs}. + +The way @file{auto-fill-inhibit.el} is implemented means that in +inhibited buffers an @code{M-x auto-fill-mode} command is suppressed +as well as mode hook calls. + +@node ascii, bar-cursor, auto-fill-inhibit, Top +@chapter ascii - ASCII code display. + +@noindent Author: Vinicius Jose Latorre + +@noindent http://www.cpqd.com.br/~vinicius/emacs/ + +This package provides a way to display ASCII code on a window, that is, +display in another window an ASCII table highlighting the current character +code. + +@noindent Commands: + +@table @samp +@item ascii-customize +Customize ASCII options. +@item ascii-display +Toggle ASCII code display. +@item ascii-on +Turn on ASCII code display. +@item ascii-off +Turn off ASCII code display. +@end table + +You can also bind @command{ascii-display}, @command{ascii-on}, +@command{ascii-off} and @command{ascii-customize} to some key, like: + +@example + (global-set-key "\C-c\C-a" 'ascii-on) + (global-set-key "\C-c\C-e" 'ascii-off) + (global-set-key "\C-c\C-t" 'ascii-display) + (global-set-key "\C-c\C-c" 'ascii-customize) +@end example + +If you're using the `mule' package, a good usage example is to activate `ascii' +on the emacs/etc/HELLO file. + + +@noindent Acknowledgments + +Thanks to Roman Belenov for suggestion on dynamic ascii +table evaluation (depending on character encoding). + +Thanks to Alex Schroeder for suggestion on customization. + +@node bar-cursor, bm, ascii, Top +@chapter bar-cursor - switch block cursor to a bar + +A simple package to convert the block cursor into a bar cursor. In +overwrite mode, the bar cursor changes back into a block cursor. +This is a quasi-minor mode, meaning that it can be turned on & off +easily though only globally (hence the quasi-). + +To enable it, customize the variable @code{bar-cursor-mode}. + +It is also listed when you customize the group @code{emacs-goodies-el}. + +@node bm, boxquote, bar-cursor, Top +@chapter bm - visible bookmarks in buffers + +@noindent Author: Jo Odland + +This package was created because I missed the bookmarks from M$ +Visual Studio. I find that they provide an easy way to navigate +in a buffer. + +bm.el provides visible, buffer local, bookmarks and the ability +to jump forward and backward to the next bookmark. + +@noindent Features: +@itemize @bullet +@item +Toggle bookmarks with @command{bm-toggle} and navigate forward and +backward in buffer with @command{bm-next} and @command{bm-previous}. + +@item +Different wrapping modes, see @code{bm-wrap-search} and +@code{bm-wrap-immediately}. Use @command{bm-toggle-wrapping} to turn +wrapping on/off. + +@item +Navigate between bookmarks only in current buffer or cycle through +all buffers. Use @command{bm-cycle-all-buffers} to enable looking +for bookmarks across all open buffers. + +@item +Setting bookmarks based on a regexp, see @code{bm-bookmark-regexp} and +@code{bm-bookmark-regexp-region}. + +@item +Setting bookmark based on line number, see @command{bm-bookmark-line}. + +@item +Goto line position or start of line, see @command{bm-goto-position}. + +@item +Persistent bookmarks (see below). Use +@command{bm-toggle-buffer-persistence} to enable/disable persistent +bookmarks (buffer local). + +@item +List bookmarks with annotations and context in a separate buffer, see +@command{bm-show} (current buffer) and @command{bm-show-all} (all +buffers). + +@item +Remove all bookmarks in current buffer with +@command{bm-remove-all-current-buffer} and all bookmarks in all open +buffers with @command{bm-remove-all-all-buffers}. + +@item +Annotate bookmarks, see @command{bm-bookmark-annotate} and +@command{bm-bookmark-show-annotation}. The annotation is displayed +in the messsage area when navigating to a bookmark. Set the variable +@code{bm-annotate-on-create} to t to be prompted for an annotation +when bookmark is created. + +@item +Different bookmark styles, fringe-only, line-only or both, see +@code{bm-highlight-style}. It is possible to have fringe-markers on +left or right side. +@end itemize + +To make it easier to use, assign the commands to some keys. + +@example +M$ Visual Studio key setup. + (global-set-key (kbd "") 'bm-toggle) + (global-set-key (kbd "") 'bm-next) + (global-set-key (kbd "") 'bm-previous) +@end example + +Click on fringe to toggle bookmarks, and use mouse wheel to move +between them. +@example + (global-set-key (kbd " ") 'bm-next-mouse) + (global-set-key (kbd " ") 'bm-previous-mouse) + (global-set-key (kbd " ") 'bm-toggle-mouse) +@end example + +If you would like the markers on the right fringe instead of the +left, add the following to line: + +@example +(setq bm-marker 'bm-marker-right) +@end example + +@noindent Persistence: + +Bookmark persistence is achieved by storing bookmark data in a +repository when a buffer is killed. The repository is saved to +disk on exit. See @code{bm-repository-file}. The maximum size of the +repository is controlled by @code{bm-repository-size}. + +The buffer local variable @code{bm-buffer-persistence} decides if +bookmarks in a buffer is persistent or not. Non-file buffers can't have +persistent bookmarks, except for *info* and indirect buffers. + +Bookmarks are non-persistent as default. To have bookmarks +persistent as default add the following line to .emacs. + +@example +;; make bookmarks persistent as default +(setq-default bm-buffer-persistence t) +@end example + +Use the function @command{bm-toggle-buffer-persistence} to toggle +bookmark persistence. + +To have automagic bookmark persistence we need to add some +functions to the following hooks. Insert the following code +into your .emacs file: + +If you are using desktop or other packages that restore buffers on start +up, bookmarks will not be restored. When using @code{after-init-hook} to +restore the repository, it will be restored *after* .emacs is +finished. To load the repository when bm is loaded set the variable +@code{bm-restore-repository-on-load} to t, *before* loading bm (and +don't use the @code{after-init-hook}). + +@example +;; Make sure the repository is loaded as early as possible +(setq bm-restore-repository-on-load t) +(require 'bm) + +;; Loading the repository from file when on start up. +(add-hook' after-init-hook 'bm-repository-load) + +;; Restoring bookmarks when on file find. +(add-hook 'find-file-hooks 'bm-buffer-restore) + +;; Saving bookmark data on killing a buffer +(add-hook 'kill-buffer-hook 'bm-buffer-save) + +;; Saving the repository to file when on exit. +;; kill-buffer-hook is not called when Emacs is killed, so we +;; must save all bookmarks first. +(add-hook 'kill-emacs-hook '(lambda nil + (bm-buffer-save-all) + (bm-repository-save))) + +;; Update bookmark repository when saving the file. +(add-hook 'after-save-hook 'bm-buffer-save) + +;; Restore bookmarks when buffer is reverted. +(add-hook 'after-revert-hook 'bm-buffer-restore) +@end example + +The @code{after-save-hook} and @code{after-revert-hook} is not necessary +to use to achieve persistence, but it makes the bookmark data in +repository more in sync with the file state. + +The @code{after-revert-hook} might cause trouble when using packages +that automatically reverts the buffer (like vc after a check-in). This +can easily be avoided if the package provides a hook that is called +before the buffer is reverted (like @code{vc-before-checkin-hook}). +Then new bookmarks can be saved before the buffer is reverted. + +@example +;; make sure bookmarks is saved before check-in (and revert-buffer) +(add-hook 'vc-before-checkin-hook 'bm-buffer-save) +@end example + +@node boxquote, browse-huge-tar, bm, Top +@chapter boxquote - Quote text with a semi-box. + +boxquote provides a set of functions for using a text quoting style that +partially boxes in the left hand side of an area of text, such a marking +style might be used to show externally included text or example code. + +@example +,---- +| The default style looks like this. +`---- +@end example + +A number of functions are provided for quoting a region, a buffer, a +paragraph and a defun. There are also functions for quoting text while +pulling it in, either by inserting the contents of another file or by +yanking text into the current buffer. + +Look for the @command{@kbd{M-x} boxquote-*} commands. + +@node browse-huge-tar, browse-kill-ring, boxquote, Top +@chapter browse-huge-tar - Browse files in a tarball memory-efficiently. + +@noindent Author: Gareth Owen + +This uses tar (z)tvf to browse a gzipped tar file without opening the +whole thing, in a dired-stylee. Knocked together in a fit of pique +after trying to read the xemacs source tarball in xemacs chewed through +all my swapspace one afternoon, and as an exercise in thesis avoidance. + +The trade off is memory usage vs. speed. This is very slow on large, +compressed tarballs, and each operation is slow individually, but +relatively low memory machines (like old 486s running one of the i386 +unices) don't handle these well with jka-compress and tar-mode either. +XEmacs-20.4 was a 13MB gzipped tarball and the similarly packaged linux +kernel 2.0.36 was 7MB, so the memory savings can be pretty high too. + +On small files the saving/price is pretty low, and +tar-mode/jka-compress have approximately 10^13 more features, so I'd +advise you to go that way. + +@noindent Commands: + +@table @samp +@item browse-huge-tar-file +Create a buffer containing a listing of FILENAME as a tar file. +@item browse-huge-tar-view-file-at-point +Extract the file at the point into a buffer for viewing. +@item browse-huge-tar-copy-file-at-point +Extract the file at the point and copy to a local file OUTFILE. +@end table + +@node browse-kill-ring, clipper, browse-huge-tar, Top +@chapter browse-kill-ring.el - interactively insert items from kill-ring. + +Ever feel that @kbd{C-y M-y M-y M-y ...} is not a great way of trying +to find that piece of text you know you killed a while back? Then +browse-kill-ring.el is for you. + +To use, type @command{@kbd{M-x} browse-kill-ring}. You can bind +@command{browse-kill-ring} to a key, like: + +@example +(global-set-key (kbd "C-c k") 'browse-kill-ring) +@end example + +Even better than doing that, though, is to set up @kbd{M-y} such that +it invokes @command{browse-kill-ring} if the last command wasn't a +yank. This great idea is from Michael Slass @email{mikesl@@wrq.com}. +Here is code (from him) to do this: + +@example +(defadvice yank-pop (around kill-ring-browse-maybe (arg)) + "If last action was not a yank, run `browse-kill-ring' instead." + (if (not (eq last-command 'yank)) + (browse-kill-ring) + ad-do-it)) + +(ad-activate 'yank-pop) +@end example + +(The emacs-goodies-el package could add a customizable variable to +set this up. Ask if this would be useful. - @email{psg@@debian.org}) + +Note that the command keeps track of the last window displayed to +handle insertion of chosen text; this might have unexpected +consequences if you do @command{@kbd{M-x} browse-kill-ring}, then +switch your window configuration, and try to use the same @code{*Kill +Ring*} buffer again. + +@node clipper, coffee, browse-kill-ring, Top +@chapter clipper - Save strings of data for further use. + +Clipper is a way to handle 'clips' of text with some persistance via handles. +A good example is something like the GNU Public License. If you do a lot of +Free Software work and need to have a copy of the GPL for insertion in your +source files, you can save this text as a 'GPL' clip. When you call +clipper-insert you will be prompted for a name and when you enter GPL this +will be inserted. + +Clipper can also perform search and replacement on token names. For example +if want the current buffer filename you can use the token +@code{CLIPPER_FILE_NAME_NONDIRECTORY}. + +@noindent Available tokens are: + +@code{CLIPPER_FILE_NAME_NONDIRECTORY}: The current filename +without its directory. If this buffer isn't saved to disk then the +buffer name is used. + +@code{CLIPPER_FILE_NAME_NONDIRECTORY_SANS_EXTENSION}: The current +filename without its directory and without an extension. + +@noindent The following functions allow you to manipulate clipper: + +@command{clipper-create} creates a new clip. + +@command{clipper-delete} deletes an existing clip. + +@command{clipper-insert} inserts a clip into the current buffer. + +@command{clipper-edit-clip} edits an existing clip. + +@noindent You might also want to setup personal key bindings: + +@example +(global-set-key "\C-cci" 'clipper-insert) +(global-set-key "\C-ccc" 'clipper-create) +@end example + +@node coffee, color-theme, clipper, Top +@chapter coffee.el - Submit BREW request to an RFC2324-compliant coffee device + +This module provides an Emacs interface to RFC2324-compliant coffee +devices (Hyper Text Coffee Pot Control Protocol, or HTCPCP). It +prompts the user for the different additives, then issues a BREW +request to the coffee device. + +coffee.el requires a special BREW-capable version of Emacs/W3 to be +installed. + +Reference: + +@quotation +You can probably guess how coffee.el came about ...yadda yadda +everything but make coffee ...yadda yadda ... +@end quotation + +To do anything at all on emacs21, coffee requires the Debian packages +@file{w3-el} and @file{w3-url-e21} to be installed. Then it will +prompt for coffee and sweetener type. Then @code{url-retrieve} will +fail since it doesn't really support the coffee URL type. So... +this package is really an elaborate joke. Because of this, it's +longer autoloaded in Debian. To try, do: + +@example +M-x load-library coffee +M-x coffee +@end example + +@node color-theme, csv-mode, coffee, Top +@chapter color-theme - install color themes + +@noindent Authors: Jonadab the Unsightly One , +Alex Schroeder , Xavier Maillard + +@noindent Maintainer: Xavier Maillard + +@noindent Installing a color theme: + +There are two ways to explore and install themes. The first is to +customize the group @code{color-theme} and then the variable +@code{color-theme-selection} and select a theme, then set the variable +for the current session to test it out. If you don't like it, either +select @code{Undo} immediately or select another theme and set it. If +you like it, set and save the customization for future sessions. + +The second method is to call the command @code{M-x +color-theme-select}. That creates a Color Theme Selection buffer. +Press @key{RET} or @key{i} on a color theme to install it for the rest +of your session. If you want to install the theme in future sessions, +read the description of the theme you like and remember the name of +the color theme function. Press @key{d} on a color theme in the Color +Theme Selection buffer to read the description. Assuming you like the +Gnome2 theme, you'll find that the function to use is called +@code{color-theme-gnome2}. Add the following to the end of your +@file{.emacs} + +@example +(require 'color-theme) +(color-theme-initialize) +(color-theme-gnome2) +@end example + +@noindent Changing menu colors: + +In Emacs 21 on X, you can set the menu colors and font using the +menu face. Example for your .emacs file: + +@example + (set-face-font 'menu "7x14") + (set-face-foreground 'menu "white"). +@end example + +If are using X, you can set the menu foreground and background using +a resource file, usually @file{.Xdefaults} or @file{.Xresources}. Usually +@file{.Xdefaults} is used when you start your session using a display +manager such as xdm or gdm. @file{.Xresources} is usually used when you +start X directly via a shell script such as startx. If you set +Emacs*Background and Emacs*Foreground in such a resource file, the +foreground and background of Emacs including the menu will be set. +If your @file{.emacs} then loads a color theme, the foreground and +background are changed -- with the exception of the menu. There is +no way to manipulate the menu foreground and background color from +elisp. You can also set more specific menu resources for Emacs in +the resource file. Here is a sample entry for your resource file: + +@example + Emacs*Background: DarkSlateGray + Emacs*Foreground: wheat +@end example + +@noindent Sharing your current color setup: + +If you have already invested time in customizing Emacs faces, please +consider sharing your current setup. Type @code{M-x +color-theme-submit} and mail the result to the maintainer of this +package (see above for mail addres). + +If you want to make sure that all your customization was exported, +type @code{M-x list-faces-display} to get a list of all faces currently +defined. This is the list of faces that @code{color-theme-print} uses. + + +@node csv-mode, ctypes, color-theme, Top +@chapter csv-mode - major mode for editing comma-separated value files. + +@noindent Author: Francis J. Wright + +This package is intended for use with GNU Emacs 21 (only) and implements +the following commands to process records of CSV (comma-separated value) +type: @command{csv-sort-fields} and @command{csv-sort-numeric-fields} +sort respectively lexicographically and numerically on a specified field +or column; @command{csv-reverse-region} reverses the order. They are +based closely on, and use, code in @file{sort.el}. +@command{csv-kill-fields} and @command{csv-yank-fields} respectively +kill and yank fields or columns, although they do not use the normal +kill ring. @command{csv-kill-fields} can kill more than one field at +once, but multiple killed fields can be yanked only as a fixed group +equivalent to a single field. @command{csv-align-fields} aligns fields +into columns; @command{csv-unalign-fields} undoes such alignment; +separators can be hidden within aligned records. `csv-transpose' +interchanges rows and columns. For details, see the documentation for +the individual commands. + +CSV mode supports a generalised comma-separated values format +(character-separated values) in which the fields can be separated by any +of several single characters, specified by the value of the customizable +user option @code{csv-separators}. CSV data fields can be delimited +by quote characters (and must if they contain separator characters). +This implementation supports quoted fields, where the quote characters +allowed are specified by the value of the customizable user option +@code{csv-field-quotes}. By default, the only separator is a comma +and the only field quote is a double quote. These user options can be +changed ONLY by CUSTOMIZING them, e.g. via the command +@command{customize-variable}. + +CSV mode commands ignore blank lines and comment lines beginning with +the value of the buffer local variable @code{csv-comment-start}, +which by default is #. The user interface is similar to that of the +standard commands @command{sort-fields} and +@command{sort-numeric-fields}, but see the major mode documentation +below. + +The global minor mode @command{csv-field-index-mode} provides display of +the current field index in the mode line, cf. +@command{line-number-mode} and @command{column-number-mode}. It is on +by default. + + +@node ctypes, dedicated, csv-mode, Top +@chapter ctypes - Enhanced font-lock support for custom defined types. + +@noindent Author: Anders Lindgren + +To activate this package in the Debian emacs-goodies-el package, +customize the group @code{ctypes}, toggle on the variable +@code{ctypes-install} and save for future seesions. This will enable +the package. Then start by using @command{ctypes-buffer} in a C file. + +@noindent Description. + +As most Emacs users know, Emacs can fontify source code buffers +using the `font-lock' package. Most of the time it does a really +good job. Unfortunately, the syntax of one of the most widely +spread languages, C, makes it difficult to fontify variable +declarations. For example, what does the following line mean: + +@verbatim + hello(foo * bar); +@end verbatim + +@enumerate +@item +A new function @code{hello} that takes one argument @code{bar} that is +a pointer to a @code{foo}, or; + +@item +call the function @code{hello} with the result of @code{foo} multiplied by +@code{bar}. +@end enumerate + +To answer the question correctly you must know whether @code{foo} is a +type or not. Unfortunately, font-lock has no way of knowing this. + +This package can search through source files hunting down typedefs. +When found, font-lock is informed and your source code will be even +more beautifully colored than before. + +Each major mode has it's own set of types. It is possible for one +major mode to inherit the types of another mode. + +Currently, this package can parse C and C++ files. (However, since +I do not use C++, the probability is high (about 12, on a scale +from 1 to 12) that I've missed something). By default C++ inherits +the types defined for C mode. + +@noindent Defining types: + +The following commands are available to define and remove types: + +@table @samp +@item ctypes-define-type +Add a type. +@item ctypes-define-type-in-mode +Add a type to another major mode. +@item ctypes-buffer +Scan a buffer for types. +@item ctypes-all-buffer +Scan all buffer for types. +@item ctypes-tags +Search through all files in a TAGS table. +@item ctypes-dir +Search a directory hierarchy for files. +@item ctypes-file +Search in a file for types. +@item ctypes-remove-type +Remove one type. +@item ctypes-remove-type-in-mode +Remove one type in another mode. +@item ctypes-clear-types +Forget all types. +@item ctypes-clear-types-all-modes +Forget all types in all major modes. +@end table + +@noindent Edit types: + +If you would like to view or change the types found you can use the +function @command{ctypes-edit}. When done press @key{C-c C-c}. +Should you like do discard your changes just kill the buffer with +@key{C-x k}. + +To edit the types for another major mode use the command +@command{ctypes-edit-types-for-mode}. + +@noindent Saving types: + +The commands @command{ctypes-write-file} and +@command{ctypes-read-file} can be used to save your hard-earned +collection of types to a file and to retrieve it later. + +The default file name is stored in the variable @code{ctypes-file-name}. + +Note that only one collection of types are managed. Should you +prefer to keep one type file per project, remember to clear the set +of known types (using the command @command{ctypes-clear-types-all-modes}) +before each new set is generated. + +@noindent At Load: + +It is possible to automatically add new types, or read specific +type files, when Emacs opens a file. + +By adding a "Local Variables" section to the end of the file +containing the variables @code{ctypes-add-types-at-load} and/or +@code{ctypes-read-files-at-load} this can be accomplished. + +For example: + +@verbatim +/* + * Local Variables: + * ctypes-add-types-at-load: ("MyType" "YourType") + * ctypes-read-files-at-load: (".ctypes") + * End: + */ +@end verbatim + +@noindent The `Auto Parse' mode: + +This package can automatically search for new types in all visited +files. Activate the minor mode @command{ctypes-auto-parse-mode} to enable +this feature. + +Add the following line to your startup file to automatically +scan all visited files: +@example + (ctypes-auto-parse-mode 1) +@end example + +@noindent Example 1: + +The following setup is for the really lazy person. The keywords +collected during one session will be kept for the next, and all +visited files will be parsed in the boldly search for new types. +I would recomend using this approach only when you are keeping all +your types in one file. + +@example +(require 'ctypes) +(setq ctypes-write-types-at-exit t) +(ctypes-read-file nil nil t t) +(ctypes-auto-parse-mode 1) +@end example + +@noindent Example 2: + +In this example, ctypes will not be not loaded until either c-mode +or c++-mode is activated. When loaded, ctypes will read the type +file @file{~/.ctypes_std_c} (containing, for example, all types defined +in the standard C header files). + +@example +(defun my-c-mode-hook () + (require 'ctypes) + (turn-on-font-lock)) +(add-hook 'c-mode-hook 'my-c-mode-hook) +(add-hook 'c++-mode-hook 'my-c-mode-hook) + +(defun my-ctypes-load-hook () + (ctypes-read-file "~/.ctypes_std_c" nil t t)) +(add-hook 'ctypes-load-hook 'my-ctypes-load-hook) +@end example + +@noindent CTypes, the true story: + +Well, brave reader, are you willing to learn what this package +really is capable of? + +Basically, it is a general purpose parsing package. The default +settings just happened to specify a parser that looks for C +typedefs, and that the default action is to add the types found to +font-lock. + +Be redefining the variable `ctypes-mode-descriptor' you can change +the behavior totally. For example, you can use it to search for +all occurrences of XX (replace XX with whatever you like) in all +files edited in major mode YY (ditto for YY) and to perform ZZ-top +whenever a new XX is found. (However, it might be difficult for +Emacs to grow a beard). + +I will, however, in the document string, write "search for types" +when I really mean "Call the parser routine as specified by +`ctypes-mode-descriptor'". Also, I write "Informing font-lock" +whenever I mean "Performing the default action as specified in +@code{ctypes-mode-descriptor}". + +@node dedicated, df, ctypes, Top +@chapter dedicated - a very simple minor mode for dedicated buffers + +@noindent Author: Eric Crampton + +This minor mode allows you to toggle a window's "dedicated" flag. +When a window is "dedicated", Emacs will not select files into that +window. This can be quite handy since many commands will use +another window to show results (e.g., compilation mode, starting +info, etc.) A dedicated window won't be used for such a purpose. + +Dedicated buffers will have "D" shown in the mode line. + +Use the command: +@example +M-x dedicated-mode +@end example + +@node df, dict, dedicated, Top +@chapter df - display space left on partitions in the mode-line. + +This is a quick hack to display disk usage in the mode-line. + +If you work with a lot of users sharing the same partition, it +sometimes happens that there is no space left to save your work, which +may drive you to serious brain damage when you lose important work. +This package allows you to have the available disk space and the buffer +size displayed in the mode-line, so you know when you can save your +file or when it's time to do some cleanup. + +df is simple to use. Add something like +@example +(df "/home") +@end example +in your .emacs if you want to scan @file{/home}. Even simpler, enable +it by customizing the group @code{df} where you can toggle on the +variable @code{df-run-on-startup}. + +@node dict, diminish, df, Top +@chapter dict - Emacs interface to dict client + +Removed in emacs-goodies-el V36.0; Use dictionary-el instead. + +@node diminish, dir-locals, dict, Top +@chapter diminish - Diminish minor-mode's display + +Minor modes each put a word on the mode line to signify that they're +active. This can cause other displays, such as % of file that point is +at, to run off the right side of the screen. For some minor modes, such +as mouse-avoidance-mode, the display is a waste of space, since users +typically set the mode in their .emacs & never change it. For other +modes, such as my jiggle-mode, it's a waste because there's already a +visual indication of whether the mode is in effect. + +A diminished mode is a minor mode that has had its mode line +display diminished, usually to nothing, although diminishing to a +shorter word or a single letter is also supported. This package +implements diminished modes. + +@noindent To create diminished modes interactively, type +@example +@kbd{M-x} diminish +@end example +@noindent to get a prompt like +@example + Diminish what minor mode: +@end example +@noindent and respond with the name of some minor mode, like +@code{mouse-avoidance-mode}. You'll then get this prompt: +@example + To what mode-line display: +@end example +Respond by just hitting @key{} if you want the name of the mode +completely removed from the mode line. If you prefer, you can abbreviate +the name. If your abbreviation is 2 characters or more, such as "Av", +it'll be displayed as a separate word on the mode line, just like minor +modes' names. If it's a single character, such as "V", it'll be scrunched +up against the previous word, so for example if the undiminished mode line +display had been "Abbrev Fill Avoid", it would become "Abbrev FillV". +Multiple single-letter diminished modes will all be scrunched together. +The display of undiminished modes will not be affected. + +To find out what the mode line would look like if all diminished modes +were still minor, type @command{@key{M-x} diminished-modes}. This +displays in the echo area the complete list of minor or diminished +modes now active, but displays them all as minor. They remain +diminished on the mode line. + +To convert a diminished mode back to a minor mode, type +@command{@key{M-x} diminish-undo} to get a prompt like +@example + Restore what diminished mode: +@end example +Respond with the name of some diminished mode. To convert all +diminished modes back to minor modes, respond to that prompt +with @code{diminished-modes} (unquoted, & note the hyphen). + +When you're responding to the prompts for mode names, you can use +completion to avoid extra typing; for example, m o u SPC SPC SPC +is usually enough to specify mouse-avoidance-mode. Mode names +typically end in "-mode", but for historical reasons +auto-fill-mode is named by "auto-fill-function". + +To create diminished modes noninteractively in your .emacs file, put +code like +@example + (require 'diminish) + (diminish 'abbrev-mode "Abv") + (diminish 'jiggle-mode) + (diminish 'mouse-avoidance-mode "M") +@end example +near the end of your .emacs file. It should be near the end so that any +minor modes your .emacs loads will already have been loaded by the time +they're to be converted to diminished modes. + +Alternatively, you can setup dimished modes using the customize +interface by customizing the variable @code{diminished-minor-modes}. +The same caveat as above applies and the minor mode libraries should +be loaded in ~/.emacs before the @code{custom-set-variables} line. + +@node dir-locals, edit-env, diminish, Top +@chapter dir-locals - local variables for a directory tree + +It can be useful to specify local variables directory-wide, e.g. to +define CC mode styles consistently. This library implements such a +scheme, controlled by the global minor mode @code{dir-locals-mode}. + +Place a file named @code{.emacs-locals} (or the value of +@code{dir-locals-file-name}) in the directory root. This should specify +local variables in the usual way. The values it sets are inherited +when a file in the directory tree is found. Local variables +specified in the found file override the directory-wide ones. + +However, `eval' pseudo-variables specified in the file are +evaluated (assuming `enable-local-eval' is true) _before_ any +directory-wide processing, and they are evaluated in a scratch +buffer, so that they are only useful for side effects on local +variables. `mode' pseudo-variables which specify minor modes +toggle those modes for files within the directory. If +.emacs-locals specifies a major mode, it doesn't propagate, but any +local variables and minor modes its hook sets will; thus it should +normally not specify a major mode. The `coding' pseudo-variable +will not propagate from .emacs-locals. + +For example, with dir-locals mode on, placing this in .emacs-locals +at the top-level of the Linux source tree would set the C +indentation style appropriately for files within the tree: + +@example + Local variables: + c-file-style: "linux" + End: +@end example + +Another possible use is, say, setting change-log parameters in +different trees for which the Emacs 22 development source broke use +of change-log-mode-hook. + +@node edit-env, egocentric, dir-locals, Top +@chapter edit-env - display and edit environment variables + +@noindent Author: Benjamin Rutt + +This file uses the widget library to display, edit, delete and add +environment variables. Inspired by @key{G c} in a gnus *Group* buffer. +Bug reports or patches are welcome, please use the above email +address. + +@noindent To use it, do: + +@example +M-x edit-env +@end example + +to enter the environment editor. To change variables, simply edit +their values in place. To delete variables, delete their values. To +add variables, add a new rows to the list at the bottom by pressing +@key{INS}; then, add a new name/value pair of the form VAR=VALUE +(e.g. FOO=BAR). After changing and/or deleting and/or adding +environment variables, press the @key{done} button at the top. Note that +environment variable changes will only be visible to your current +emacs session or child processes thereof. + +@node egocentric, eproject, edit-env, Top +@chapter egocentric - highlight your name inside emacs buffers + +@noindent Author: Benjamin Drieu + +This package highlights occurrences of your own name and/or +nickname. Quite useful for daily kibozing. + +Main purpose is to be used within your favourite Emacs mailer. To +use egocentric.el with Gnus, simply use the following inside your +Gnus init file. + +@example +(add-hook 'gnus-article-prepare-hook 'egocentric-mode) +(autoload 'egocentric-mode "egocentric" + "Highlight your name or various keywords in buffers") +@end example + +@node eproject, ff-paths, egocentric, Top +@chapter eproject.el - assign files to projects, programatically + +@noindent Author: Jonathan Rockway + +Eproject is an extension that lets you group related files together +as projects. It aims to be as unobtrusive as possible -- no new +files are created (or required to exist) on disk, and buffers that +aren't a member of a project are not affected in any way. + +The main starting point for eproject is defining project types. +There is a macro for this, define-project-type, that accepts four +arguments, the type name (a symbol), a list of supertypes (for +inheriting properties), a form that is executed to determine +whether a file is a member of a project, and then a free-form +property list. An example will clear things up. + +Let's create a "perl" project type, for Perl projects that have a +Makefile.PL. + +@example +(define-project-type perl (generic) + (look-for "Makefile.PL") + :relevant-files ("\\.pm$" "\\.t$")) +@end example + +Now when you open a file and somewhere above in the directory tree +there is a Makefile.PL, it will be a "perl project". + +There are a few things you get with this. A hook called +perl-project-file-visit-hook will be run, and the buffer will have +the "eproject-mode" minor-mode turned on. You can also read and +set metadata via the eproject-attribute and +eproject-add-project-metadatum calls. + +(This is mostly helpful to Lisp programmers rather than end-users; +if you want tools for visiting and managing projects (and ibuffer +integration), load `eproject-extras'. These extras are great +examples of the eproject API in action, so please take a look even +if you don't want those exact features.) + +Let's look at the mechanics of the define-project-type call. The +first argument is the name of the project type -- it can be any +symbol. The next argument is a list of other projects types that +this project will inherit from. That means that if you call +eproject-get-project-metadatum and the current project doesn't +define a value, we'll look at the supertypes until we get something +non-nil. Usually you will want to set this to (generic), which +will make your type work correctly even if you don't define any of +your own metadata. + +The next argument is a form that will be executed with the filename +that was just opened bound to FILE. It is expected to return the +project root, or nil if FILE is not in a project of this type. The +look-for function will look up the directory tree for a file that +is named the same as its argument (see the docstring for +`eproject--look-for-impl' for all the details). You can write any +Lisp here you like; we'll see some more examples later. (You only +get one form, so if you need to execute more than one, just wrap it +in a progn.) + +The final (&rest-style) argument is a property list of initial project +metadata. You can put anything you want here, as long as it is in the +form of a property list (keyword, value, keyword, value, ...). + +After this form runs, eproject will be able to recognize files in +the type of the project you defined. It also creates a hook named +-project-file-visit-hook. You can do anything you want here, +including access (eproject-type) and (eproject-root). + +As an example, in my perl-project-file-visit-hook, I do this: + +@example +(lambda () + (ignore-errors + (stylish-repl-eval-perl + (format "use lib '%s'" (car (perl-project-includes))))))) +@end example + +This will add the library directory of this project to my current +stylish-repl session, so that I can use my project in the REPL +immediately. (I do something similar for Lisp + SLIME projects) + +That's basically all there is. eproject is designed to be minimal and +extensible, so I hope it meets your needs. + +Public API: + +@itemize @bullet +@item +wweproject-root (&optional buffer) + +returns the project root for the project that buffer is a member + of. defaults to the current buffer + +@item +eproject-attribute (key &optional root) + +returns the value of key for the project that buffer is a member of. +root defaults to the current buffer's eproject-root + +@item +eproject-list-project-files + +@item +define-project-type + +@item +define-project-attribute + +@item +eproject-projects +@end itemize + +Everything else is mostly used internally, and may change. + +Public commands: + +@itemize @bullet +@item +eproject-maybe-turn-on + +turn on eproject for the current buffer, if possible + (if it's turned on, the hooks will be run) + +@item +eproject-reinitialize-project + +re-read config for the current project, then run +eproject-maybe-turn-on + +this is bound to @key{C-c C-c} when editing .eproject files, which is very +convenient for testing. +@end itemize + +The wiki has lots more documentation: +http://wiki.github.com/jrockway/eproject + +@node ff-paths, filladapt, eproject, Top +@chapter ff-paths - searches certain paths to find files. + +This code allows you to use C-x C-f normally most of the time, except that +if the requested file doesn't exist, it is checked against a list of +patterns for special paths to search for a file of the same name. + +@noindent Examples: +@itemize @bullet + @item a file extension of @file{.bib} will cause to search the path +defined in $BSTINPUTS or $BIBINPUTS for the file you requested. + @item a file extension of @file{.h} will cause the @file{/usr/include/} +and @file{/usr/local/include/} directory trees to be searched. + @item a file extension of @file{.sty} causes a search of TEXINPUTS and +of all directories below @file{"/usr/share/texmf/tex/} + @item a file extension of @file{.el} causes a search of the path set in +the emacs variable @code{load-path}. + @item If the aboves searches don't return a match, the filename is +searched for using the @file{locate} command (if available on your +system). + @item gzip-compressed files (@file{.gz}) will also be found by ff-paths +if the package jka-compr is present. If you use some other package, +simply set the @code{ff-paths-gzipped} variable to t: +@end itemize + +If one file is found, or many files of the same name are found, then the +*completions* buffer is displayed with all possibilities, including the +non-existing path you first provided. Selecting it creates the new +file. + +This package runs as a find-file-not-found-hooks hook, and so will +happily live alongside other such file-finding mechanisms (e.g. +PC-look-for-include-file PC-try-load-many-files vc-file-not-found-hook) + +The patterns to test against filenames and the associated paths to search +for these files can be modified by the user by editing the variable +@code{ff-paths-list} + +I suggest that you use ffap.el by Michelangelo Grigni , +now part of GNU Emacs. His package will guess the filename from the +text under the editing point. It will search for an existing file in +various places before you even get the "File: " prompt. ff-paths will +provide itself to ffap as an additional tool to locate the file before +you ever see a prompt. ff-paths behaves slightly differently with ffap +than it does with find-file: if the file path selected under point by +ffap does not exist, it is not shown in the completions buffer along +with existing paths. If only one existing path is found for said file, +it is placed in the minibuffer at the ffap prompt. Also, since using +the `locate' command is fairly aggressive, it is not used in the ffap +toolkit. + +@noindent Installation: + +ff-paths installs itself as a hook in find-file-not-found-hooks for +find-file. If ffap is installed, ff-paths installs itself as a +toolbox hook in ffap-alist. + +To use it, customize the variable @code{ff-paths-install}. + +To also enable ffap, customize the variable @code{ff-paths-use-ffap}. + +Both of the above are enabled if you customize the variable +@code{emacs-goodies-el-defaults} to t (its aggressive state). + +You may alter various settings of @code{ff-paths} using the +customization group @code{ff-paths}. + +@node filladapt, floatbg, ff-paths, Top +@chapter filladapt - adaptively set fill-prefix and overload filling functions + +These functions enhance the default behavior of Emacs' Auto Fill +mode and the commands @code{fill-paragraph}, @code{lisp-fill-paragraph}, +@code{fill-region-as-paragraph} and @code{fill-region}. + +The chief improvement is that the beginning of a line to be +filled is examined and, based on information gathered, an +appropriate value for fill-prefix is constructed. Also the +boundaries of the current paragraph are located. This occurs +only if the fill prefix is not already non-nil. + +The net result of this is that blurbs of text that are offset +from left margin by asterisks, dashes, and/or spaces, numbered +examples, included text from USENET news articles, etc. are +generally filled correctly with no fuss. + +Note that in this release Filladapt mode is a minor mode and it is +_off_ by default. If you want it to be on by default, use +@example + (setq-default filladapt-mode t) +@end example + +@code{M-x filladapt-mode} toggles Filladapt mode on/off in the current +buffer. + +Filladapt works well with any language that uses comments that +start with some character sequence and terminate at end of line. +So it is good for Postscript, Lisp, Perl, C++ and shell modes. + +Use +@example + (add-hook 'text-mode-hook 'turn-on-filladapt-mode) +@end example +to have Filladapt always enabled in Text mode, or customize the +variable @code{filladapt-turn-on-mode-hooks}. + +In C mode, @code{c-setup-filladapt} arranges for filling of block +style comments (@pxref{Text Filling and Line Breaking,,, ccmode, CC +Mode}). + +@example + (add-hook 'c-mode-hook 'turn-on-filladapt-mode) + (add-hook 'c-mode-hook 'c-setup-filladapt) +@end example + +Old versions of CC Mode (eg.@: the version with Emacs 20) don't have +@code{c-setup-filladapt} and you may instead want to use +@code{turn-off-filladapt-mode}. + +In many cases, you can extend Filladapt by adding appropriate entries +to the following three custiomizable variables. See +@code{postscript-comment} or @code{texinfo-comment} as a sample of +what needs to be done. + +@example + filladapt-token-table + filladapt-token-match-table + filladapt-token-conversion-table +@end example + +@node floatbg, folding, filladapt, Top +@chapter floatbg - slowly modify background color + +Floatbg slowly modifies the backgound color through an hsv color +model, like floatbg for X-Windows by Jan Rekers. + +To enable it, customize the variable @code{floatbg-mode}. +There are other tweaks to set in the customization group +@code{floatbg}. + +@node folding, framepop, floatbg, Top +@chapter folding - A folding-editor-like minor mode. + +@noindent Author: Jamie Lokier +Jari Aalto +Anders Lindgren + +@noindent Preface + + This package provides a minor mode, compatible with all major + editing modes, for folding (hiding) parts of the edited text or + program. + + Folding mode handles a document as a tree, where each branch + is bounded by special markers @{@{@{ and @}@}@}. A branch can be + placed inside another branch, creating a complete hierarchical + structure. + + Folding mode can CLOSE a fold, leaving only the initial `@{@{@{' + and possibly a comment visible. + + It can also ENTER a fold, which means that only the current + fold will be visible, all text above `@{@{@{' and below `@}@}@}' + will be invisible. + + Please note, that the maintainers do not recommend to use only + folding for you your code layout and navigation. Folding.el is + on its best when it can "chunk" large sections of code inside + folds. The larger the chunks, the more the usability of + folding will increase. Folding.el is not meant to hide + individual functions: you may be better served by hideshow.el + or imenu.el (which can parse the function indexes) + +@menu +* folding Installation:: +* folding documentation:: +* folding custom:: +* folding examples:: +@end menu + + +@node folding Installation, folding documentation, folding, folding +@section Folding installation + + The best way to use folding is to turn it on explicitely when + needed using @command{M-x folding-mode}. + + But if you always use folding, then consider adding these lines + to your @file{~/.emacs} file: + +@example + (if (load "folding" 'nomessage 'noerror) + (folding-mode-add-find-file-hook)) +@end example + + The same folding marks can be used in `vim' editor command + "set fdm=marker". + +@noindent To remove folding, call `M-x' `folding-uninstall'. + +@node folding documentation, folding custom, folding Installation, folding +@section Folding documentation + +@noindent Tutorial + + To start folding mode, give the command: @command{M-x +folding-mode}. The mode line should contain the string "Fld" +indicating that folding mode is activated. + + When loading a document containing fold marks, Folding mode is +automatically started and all folds are closed. For example when +loading my init file, only the following lines (plus a few lines of +comments) are visible: + +@verbatim +;;{{{ General... +;;{{{ Keyboard... +;;{{{ Packages... +;;{{{ Major modes... +;;{{{ Minor modes... +;;{{{ Debug... +@end verbatim + + To enter a fold, use @key{C-c @ >}. To show it without entering, use +@key{C-c @ C-s}, which produces this display: + +@verbatim +;;{{{ Minor modes + +;;{{{ Follow mode... +;;{{{ Font-lock mode... +;;{{{ Folding... + +;;}}} +@end verbatim + + To show everything, just as the file would look like if Folding +mode hadn't been activated, give the command @command{M-x +folding-open-buffer}, normally bound to @key{C-c @ C-o}. To +close all folds and go to the top level, the command +@command{folding-whole-buffer} could be used. + +@noindent Mouse support + + Folding mode v2.0 introduced mouse support. Folds can be shown or +hidden by simply clicking on a fold mark using mouse button 3. The +mouse routines have been designed to call the original function bound +to button 3 when the user didn't click on a fold mark. + +@noindent The menu + + A menu is placed in the "Tools" menu. Should no Tools menu exist +(Emacs 19.28) the menu will be placed in the menu bar. + +@noindent ISearch + + When searching using the incremental search (C-s) facilities, +folds will be automagically entered and closed. + +@noindent Problems + + Uneven fold marks + + Oops, I just deleted some text, and a fold mark got deleted! +What should I do? Trust me, you will eventually do this sometime. the +easiest way is to open the buffer using @command{folding-open-buffer} +(@key{C-c @ C-o}) and add the fold mark by hand. To find mismatching +fold marks, the package `occur' is useful. The command: + +@verbatim + M-x occur RET {{{\|}}} RET +@end verbatim + + will extract all lines containing folding marks and present them +in a separate buffer. + + Even though all folding marks are correct, Folding mode sometimes +gets confused, especially when entering and leaving folds very +often. To get it back on track, press @key{C-g} a few times and give the +command @command{folding-open-buffer} (@key{C-c @ C-o}). + + Fold must have a label + + When you make a fold, be sure to write some text for the name of +the fold, otherwise there may be an error "extraneous fold mark..." +Write like this: + +@verbatim + ;;{{{ Note + ;;}}} +@end verbatim + + instead of + +@verbatim + ;;{{{ + ;;}}} +@end verbatim + + folding-whole-buffer doesn't fold whole buffer + + If you call commands @command{folding-open-buffer} and +@command{folding-whole-buffer} and notice that there are open fold +sections in the buffer, then you have mismatch of folds somewhere. Run +@command{M-x occur} and type the regexp @code{@{@{@{\|@}@}@}} to check where +is the extra open or closing fold mark. + +@noindent Folding and outline modes + + Folding mode is not the same as Outline mode, a major and minor +mode which is part of the Emacs distribution. The two packages do, +however, resemble each other very much. The main differences between +the two packages are: + +@itemize @bullet +@item +Folding mode uses explicit marks, @code{@{@{@{} and `@}@}@}', to +mark the beginning and the end of a branch. +Outline, on the other other hand, tries to use already +existing marks, like the `\section' string in a TeX +document. + +@item +Outline mode has no end marker which means that it is +impossible for text to follow a sub-branch. + +@item +Folding mode use the same markers for branches on all depths, +Outline mode requires that marks should be longer the +further, down in the tree you go, e.g `\chap', \section', +`\subsection', `\subsubsection'. This is needed to +distinguish the next mark at the current or higher levels +from a sub-branch, a problem caused by the lack of +end-markers. + +@item +Folding mode has mouse support, you can navigate through a +folded document by clicking on fold marks. (The XEmacs version +of Outline mode has mouse support.) + +@item +The Isearch facilities of Folding is capable of +automatically to open folds. Under Outline, the the entire +document must be opened prior isearch. +@end itemize + + In conclusion, Outline mode is useful when the document being +edited contains natural markers, like LaTeX. When writing code natural +markers are hard to find, except if you're happy with one function per +fold (I'm not). + +@noindent Personal reflections by Anders Lindgren + + When writing this, version 2.0 of Folding mode is just about to +be released. The current version has proven itself stable during a +months of testing period. In other words: we haven't had time to touch +the folding for quite some time. + + Our plan was from the beginning to rewrite the entire package, +including replacing the core of the program, written using old Emacs +technology (selective display), and replace it with modern +equivalences, like overlays or text-properties for Emacs and extents +for XEmacs. + + Unfortunately, this has not yet been done, even though we have +implemented most other items on our to-do agenda. + + It is not likely that any of us, even in the near future, will +find the time required to rewrite the core of the package. Since the +package, in it's current state, is much more powerful than the +original, we have decided to release this code. + +@node folding custom, folding examples, folding documentation, folding +@section Folding customization + +@noindent Customization: general + + The behavior of Folding mode is controlled mainly by a set of +Emacs Lisp variables. This section will discuss the most useful ones, +for more details please see the code. The descriptions below assumes +that you know a bit about how to use simple Emacs Lisp and knows how +to edit ~/.emacs, your init file. + +@noindent Customization: hooks + + The normal procedure when customizing a package is to write a +function doing the customization. The function is then added to a hook +which is called at an appropriate time. (Please see the example +section below.) The following hooks are available: +@table @samp +@item folding-mode-hook +Called when folding mode is activated. +@item -folding-hook +Called when starting folding mode in a buffer with major +mode set to . (e.g. When editing C code +the hook `c-mode-folding-hook' is called.) +@item folding-load-hook +Called when folding mode is loaded into Emacs. +@end table + +@noindent Customization: The Mouse + + The variable @code{folding-behave-table} contains the actions +which should be performed when the user clicks on an open fold, a +closed fold etc. For example, if you prefer to `enter' a fold rather +than `open' it you should rebind this variable. + + The variable @code{folding-default-mouse-keys-function} contains +the name of the function used to bind your mouse keys. To use your own +mouse bindings, create a function, say +@command{my-folding-bind-mouse}, and set this variable to it. + +@noindent Customization: Keymaps + + When Emacs 19.29 was released, the keymap was divided into strict +parts. (This division existed before, but a lot of packages, even the +ones delivered with Emacs, ignored them.) + +@verbatim + C-c -- Reserved for the users private keymap. + C-c C- -- Major mode. (Some other keys are + reserved as well.) + C-c + -- Reserved for minor modes. +@end verbatim + + The reason why @key{C-c@@} was chosen as the default prefix is +that it is used by outline-minor-mode. It is not likely that few +people will try to use folding and outline at the same time. + + However, old key bindings have been kept if possible. The +variable @code{folding-default-keys-function} specifies which function +should be called to bind the keys. There are various function to +choose from how user can select the keybindings. To use the old key +bindings, add the following line to your init file: + +@verbatim + (setq folding-default-keys-function + 'folding-bind-backward-compatible-keys) +@end verbatim + + To define keys similar to the keys used by Outline mode, use: + +@verbatim + (setq folding-default-keys-function + 'folding-bind-outline-compatible-keys) +@end verbatim + +@noindent Customization: adding new major modes + + To add fold marks for a new major mode, use the function +@command{folding-add-to-marks-list}. Example: + +@verbatim + (folding-add-to-marks-list + 'c-mode "/* {{{ " "/* }}} */" " */" t) + (folding-add-to-marks-list + 'java-mode "// {{{ " "// }}}" nil t) +@end verbatim + +@noindent Customization: ISearch + + If you don't like the extension folding.el applies to isearch, +set the variable `folding-isearch-install' to nil before loading this +package. + +@node folding examples, , folding custom, folding +@section Folding examples + +@noindent Example: personal setup + + To define your own key binding instead of using the standard +ones, you can do like this: + +@verbatim + (setq folding-mode-prefix-key "\C-c") + ;; + (setq folding-default-keys-function + '(folding-bind-backward-compatible-keys)) + ;; + (setq folding-load-hook 'my-folding-load-hook) + + + (defun my-folding-load-hook () + "Folding setup." + + (folding-install) ;; just to be sure + + ;; ............................................... markers ... + + ;; Change text-mode fold marks. Handy for quick + ;; sh/perl/awk code + + (defvar folding-mode-marks-alist nil) + + (let* ((ptr (assq 'text-mode folding-mode-marks-alist))) + (setcdr ptr (list "# {{{" "# }}}"))) + + ;; ........................................ bindings ... + + ;; Put `folding-whole-buffer' and `folding-open-buffer' + ;; close together. + + (defvar folding-mode-prefix-map nil) + + (define-key folding-mode-prefix-map "\C-w" nil) + (define-key folding-mode-prefix-map "\C-s" + 'folding-show-current-entry) + (define-key folding-mode-prefix-map "\C-p" + 'folding-whole-buffer)) +@end verbatim + +@noindent Example: changing default fold marks + + In case you're not happy with the default folding marks, you can +change them easily. Here is an example + +@verbatim + (setq folding-load-hook 'my-folding-load-hook) + + (defun my-folding-load-hook () + "Folding vars setup." + (let* ((ptr (assq 'text-mode folding-mode-marks-alist))) + (setcdr ptr (list "# {{{" "# }}}")))) +@end verbatim + + +@noindent Example: choosing different fold marks for mode + + Suppose you sometimes want to use different fold marks for the +major mode: e.g. to alternate between "# @{@{@{" and "@{@{@{" in `text-mode' +Call @command{M-x my-folding-text-mode-setup} to change the marks. + +@verbatim + (defun my-folding-text-mode-setup (&optional use-custom-folding-marks) + (interactive + (list (y-or-n-p "Use Custom fold marks now? "))) + (let* ((ptr (assq major-mode folding-mode-marks-alist)) + (default-begin "# {{{") + (default-end "# }}}") + (begin "{{{") + (end "}}}")) + (when (eq major-mode 'text-mode) + (unless use-custom-folding-marks + (setq begin default-begin end default-end))) + (setcdr ptr (list begin end)) + (folding-set-marks begin end))) +@end verbatim + +@noindent Example: AucTex setup + + Suppose you're using comment.sty with AucTeX for editing LaTeX2e +documents and you have these comment types. You would like to be able +to set which of these 3 is to be folded at any one time, using a +simple key sequence: move back and forth easily between the different +comment types, e.g., "unfold everything then fold on \x". + +@verbatim + \O ... \endO + \L ... \endL + \B ... \endB + + (setq folding-load-hook 'my-folding-load-hook) + + (defun my-folding-load-hook () + "Folding vars setup." + (let ((ptr (assq 'text-mode folding-mode-marks-alist))) + (setcdr ptr (list "\\O" "\\endO")) + (define-key folding-mode-prefix-map "C" + 'my-folding-marks-change))) + + (defun my-folding-marks-change (&optional selection) + "Select folding marks: prefixes nil, C-u and C-u C-u." + (interactive "P") + (let ((ptr (assq major-mode folding-mode-marks-alist)) + input) + (when (string-match "^\\(plain-\\|la\\|auc\\)?tex-" + (symbol-name major-mode)) + (setq input + (read-string "Latex \\end(X) Marker (default O): " + nil nil "O" nil)) + (setq input (upcase input)) + (turn-off-folding-mode) + (folding-add-to-marks-list + major-mode + (concat "\\" input) (concat "\\end" input) nil nil t) + ;; (setcdr ptr (list (concat "\\" input) (concat "\\end" input))) + (turn-on-folding-mode)))) + ;; End of example +@end verbatim + + +@node framepop, graphviz-dot-mode, folding, Top +@chapter framepop - display temporary buffers in a dedicated frame + +Framepop makes temporary buffers such as *Help* or *Completions* +appear in a separate frame which is easily dismissed when no longer +needed. + +@menu +* announcement:: Announcement on gnu-emacs-sources +* Purpose:: What's it's for +* Quick Setup:: Get going within a minute +* Customization:: Extra settings +* For elisp hackers:: More extra seetings for teh adventurous +* Bugs:: Or limitations +@end menu + +@node announcement, Purpose, framepop, framepop +@section announcement on gnu-emacs-sources + +@noindent FROM: David M Smith +@noindent DATE: 08/14/1996 10:01:29 +@noindent SUBJECT: Framepop 2.19 + +@noindent Get that *Completions* buffer outta my face!!!" + +Are you tired of hearing this plaintive cry echoing around your +office? Are you sick of having two-line *Help* messages taking up half +of your Emacs frame? Are you endlessly frustrated by having that +useful mode description in *Help* being overwritten by some useless +output from @key{C-h k}? Well, have WE got the package for YOU! + +Yes, it`s FramePop -- the NEW and IMPROVED successor to that old Emacs +18 favourite, popper.el. As if by MAGIC, the ``progeny of popper`` +takes care of temporary buffers like *Help* and *Completions* by +making them appear in their own, separate shrink-wrapped FramePop +frame, to be read at your leisure without destroying your +painstakingly created window configuration. The framepop frame is +automatically sized to your taste, taking up as little of your +precious VDU screen real estate as possible. And, what`s more, it +comes in *your choice* of colours and font. How much would you expect +to pay for this INCREDIBLY USEFUL feature? Well, DON`T ANSWER! Because +you also get the amazing FramePop Frame ToolKit KeyMap, providing +every command you would ever need to manipulate the amazing FramePop +Frame. You can scroll it, you can resize it, you can even iconify it +completely. A complete suite of manipulation commands, yours as our +gift even if you decide to return the FramePop package. + +A package like this could cost hundreds of pesetas in the stores, but +how much would @strong{you} expect to pay? Well, DON`T ANSWER! Because you +also get the incredible FramePop Frame Duplicator! Got a temporary +frame you want to keep around as a reference? Just hit those keys, and +in just microseconds you can have a copy of your own -- in yet another +shrink-wrapped Emacs frame -- to keep as your own for as long as you +wish. But what if it`s a *Help* buffer, I hear you ask? Won`t it be +overwritten next time a *Help* buffer is created? That`s no problem +for the FramePop Frame Duplicator! Just give it a prefix argument, and +it not only copies the frame but it copies the buffer AS WELL! It even +gives it a stylishly chosen NEW NAME! + +That`s right, you get the FramePop frame in your choice of colours and +font, the FramePop Frame ToolKit KeyMap and the amazing FramePop Frame +Duplicator, @strong{plus} the no-money-back GPL "NO WARRANTY" guarantee, for +the incredible, never-to-be-repeated price of ABSOLUTELY NOTHING! +Remember, FramePop is not available in stores. Eval now! Send no +money -- we won`t bill you. Eval now! + +SPECIAL OFFER: If you install FramePop in the next 48 hours you`ll +receive FramePop: the Deluxe Limited Edition 2.19! All the features of +the original FramePop 2.17 plus extra bugfixes, leaner code (which +doesn`t require advice) and better interaction with completion and the +minibuffer. Extra value at no extra cost if you act now! + +@node Purpose, Quick Setup, announcement, framepop +@section Purpose + +Defines temp-buffer-show-function to display buffers in a dedicated +temporary frame (and so requires a display which can accomodate +separate frames). The frame is automatically shrink-wrapped to just +contain the buffer (restricted to a maximum and minimum +size). Buffers thus affected include *Help*, completion buffers and +buffer listings. + +Commands are provided for manipulating the FramePop frame: +scrolling, resizing, window manager functions, and also a facility +for copying the displayed buffer. You need never lose that handy +*Help* buffer again! + +Framepop is orthogonal to the Emacs' special-display-buffers feature; +you can use both at the same time if you so desire. You can make +special-display buffers appear in the FramePop frame as well, if you +wish; see below. + +@node Quick Setup, Customization, Purpose, framepop +@section Quick Setup + +Since framepop is already installed and byte-compiled in this packaged +form, this setup can all be done using the custom interface with +@command{M-x customize-group framepop}. + +To use framepop, you must first enable it. Customize the variable +@code{framepop-enable} to @code{on}. + +Then you'll need to enable a keybing to the @code{framepop-map} +keymap. We suggest using @key{F2}. Customize the variable +@code{framepop-enable-keybinding} and select @key{F2} or some other +string that represents a key you'd prefer. + +You may then optionally extend Framepop's functionality by allowing it +to use the @code{advice} library to advise other functions. Select +this option by customizing the variable @code{framepop-use-advice} to +@code{on}. + +Save all these settings and you are ready to go. + +Type @command{M-x framepop-display-help} (bound to @key{?} in +framepop-map) for more information about the available commands +to control the new frame. For example, @key{F2} iconizes the Framepop +frame, so if you used the suggested binding of @key{F2} above for the +Framepop keymap pressing @key{F2} twice will dismiss the frame. + +@node Customization, For elisp hackers, Quick Setup, framepop +@section Customization + +More detailed customization is available via @code{M-x customize-group +RET framepop'}. This sections discusses some of them. + +The maximum and minimum height of the framepop buffer are +determined by the user options @code{framepop-max-frame-size} and +@code{framepop-min-frame-size}. + +The variable @code{framepop-frame-parameters} holds the Framepop frame +parameters. You can define colours, fonts and positions for the +Framepop frame here. For example: + +@verbatim + (setq framepop-frame-parameters + '((name . nil) ; use buffer name + (unsplittable . t) ; always include this + (menu-bar-lines . 0) ; no menu bar + (minibuffer . nil) ; or minubuffer + (left . -1) ; top left corner of screen, + (top . 30) ; away from my main frame + (width . 71) ; narrower, so it fits nicely + (background-color . "orchid4") ; I like purple. So sue me. + (foreground-color . "cornsilk") + (font . "-*-courier-bold-o-*-*-12-*-*-*-m-*-*-*"))) +@end verbatim + +But you may use the customize interface to edit +@code{framepop-frame-parameters}. + +By default, only temporary buffers (which call +@code{temp-buffer-show-function}) are displayed in the FramePop frame. +To make other buffers also appear in the selected frame, the easiest +thing to do is make buffers listed in special-display-buffer-names or +special-display-regexps appear in the framepop frame by adding the +following to your @file{~/.emacs} file: + +@example +(setq special-display-function 'framepop-special-display) +@end example + +@noindent Here's a suggestion for some buffers to use this feature on: + +@example +(setq special-display-buffer-names + '("*Shell Command Output*" "*grep*" "*compilation*")) +@end example + +Alternatively (if you want to keep the special-display feature +separate from framepop) you can use the function @code{framepop-wrap}. + +There are lots of nifty things that can be done with the advice +package to make FramePop work that much better. Many such things +will be done for you automatically if you + +@example + (require 'advice) +@end example + +before loading the framepop package (or customize the variable +@code{framepop-use-advice}. + +Buffer names listed in the variable @code{framepop-do-not-display-list} +will not be displayed in the framepop-frame by default. + +You may set the variable @code{framepop-auto-resize} to @code{on} to +have the FramePop frame automatically resize to accomodate buffers +which change size. If you do not, initially empty buffers (which are +likely to grow) get a FramePop frame of full size. + +@node For elisp hackers, Bugs, Customization, framepop +@section For elisp hackers + +Alternatively, for greater control over the behaviour of the +framepop frame, you can redefine the variable `framepop-lines' to a +lambda expression which will return the desired height of a buffer +to be displayed in the framepop frame. It may also return nil, +meaning that the buffer should not be displayed in the FramePop +frame, but in an ordinary window instead. The default value of this +lambda expression is the number of lines in the buffer, except that +empty buffers and compilation buffers (both of which are likely to +grow) get full size. You may wish to disable this feature, or +perhaps make other constraints based on buffer mode, etc. For +example, placing the following in your .emacs will force the +framepop frame to have as many lines as the buffer being displayed +provided it is not the *Completions* buffer (which will not be +displayed in the FramePop frame at all): + +@verbatim + (setq framepop-lines + '(lambda (buf) + (if (string= (buffer-name buf) "*Completions*") nil + (save-excursion + (set-buffer buf) + (+ (count-lines (point-min) (point-max)) 1))))) +@end verbatim + +This will cause empty buffers to have the minimum height, because +the maximum and minimum frame sizes (as specified in +@code{framepop-max-frame-size} and @code{framepop-min-frame-size}) are enforced +independently of @code{framepop-lines}. To get around this, define advice +around the function @code{framepop-frame-height}. + +The default value of @code{framepop-lines} is framepop-default-lines. + +@node Bugs, , For elisp hackers, framepop +@section Bugs + +@enumerate +@item +Completion in comint buffers doesn't work very well unless +comint-dynamic-show-completions is given a lobotomy. NB: this happens +by default if @code{framepop-use-advice} is customized to @code{on}. +@item +I'd like to redefine framepop-wrap so that it saves the window +configuration, displays the requested buffer in the +framepop-frame, and then restores the window configuration. But +the job of framepop-wrap is better done by +special-display-buffer-names, so I shan't bother. +@end enumerate + +@node graphviz-dot-mode, highlight-beyond-fill-column, framepop, Top +@chapter graphviz-dot-mode - mode for the dot-language used by graphviz. + +@noindent Author: Pieter Pareit + +@noindent http://users.skynet.be/ppareit/projects/graphviz-dot-mode/graphviz-dot-mode.html + +Use this mode for editing files in the dot-language (www.graphviz.org and +http://www.research.att.com/sw/tools/graphviz/). + +The graphviz-dot-mode will do font locking, indentation, preview of graphs +and eases compilation/error location. There is support for both GNU Emacs +and XEmacs. + +Font locking is automatic, indentation uses the same commands as other +modes, @key{tab}, @key{M-j} and @key{C-M-q}. Insertion of comments uses +the same commands as other modes, @key{M-;}. You can compile a file +using @code{M-x compile} or @key{C-c c}, after that @code{M-x +next-error} will also work. There is support for viewing an generated +image with @key{C-c p}. + +@node highlight-beyond-fill-column, highlight-completion, graphviz-dot-mode, Top +@chapter highlight-beyond-fill-column - fontify beyond the fill-column. + +This defines a function that can be used by @code{font-lock-add-keyword}' to +find the columns that are beyond @code{fill-column}'. It does not currently +work in XEmacs because it lacks the function @code{font-lock-add-keywords}. + +Enable it on a buffer using @code{M-x highlight-beyond-fill-column}. +You may use that command in a hook (e.g. @code{text-mode-hook}). + +Use @code{customize-face highlight-beyond-fill-column-face} to to +setup the face used for highlight-beyond-fill-column. + +@node highlight-completion, highlight-current-line, highlight-beyond-fill-column, Top +@chapter highlight-completion - completion with highlighted provisional text + +This package modified how Emacs performs completions. Ordinarily, +if you are typing a file name into the minibuffer (after hitting +@key{C-x C-f}, say), if you type a few letters and hit the TAB key, then +Emacs completes as far as possible. For example, suppose the +directory contains only these files: +@example + filbert filibuster frank grunge.tex +@end example +If you type @key{g} followed by TAB, then @code{runge.tex} is +inserted. If you hit @code{fi} then TAB, an @code{l}' is inserted. +If you hit @code{f} then TAB, there is no unique continuation of the +file name, so Emacs opens up a new window displaying the list of +possible completions. + +That's the old system. This package provides a variant: if you +type @key{g}, then @code{runge.tex} is automatically inserted as highlighted +text, to indicate that it's only provisional. The point remains +immediately after the @code{g}. If you hit TAB, the point jumps to the +end, and the added text is no longer highlighted. (So if you +weren't looking at the screen, you wouldn't know that anything +different had happened.) If after hitting @code{g}, you typed @code{a} +(because you wanted to find a new file 'gaptooth.el') the +highlighted text would disappear. The effects of various keys: + +@itemize @bullet + @item @key{TAB}: jump forward to the end of the highlighted text. If no + text is highlighted, open up a window showing possible + completions. + + @item @key{SPC}: jump forward a word (so 'g' followed by SPC would yield + 'grunge.tex', with the point after the '.', and with 'tex' + highlighted). If no text is highlighted, open up a window + showing possible completions. + + @item @key{?}: open up a window showing possible completions. + + @item @key{RET}: open the named file (so 'g' followed by RET would open + 'grunge.tex'). + + @item @key{C-g}: delete the highlighted text and stop this modified + completion process (and exit the minibuffer, if you're in the + minibuffer). + + @item @key{C-c}: delete the highlighted text and stop this modified + completion process. + + @item @key{character}: if consistent with completion, unhighlight it and + move the point forward. if inconsistent, insert the + character and delete the highlighted text, stopping this + completion process. +@end itemize + +@noindent Turn on highlight completion by either: running +@example + M-x highlight-completion-mode +@end example +or customizing the variables in the group @code{highlight-completion} +and turn on "Highlight completion mode". You may want to modify some +of the entries in "Highlight completion list". + +@noindent You can also run the functions + +@verbatim + hc-completing-insert-file-name to complete file names + hc-completing-insert-lisp-function lisp functions + hc-completing-insert-lisp-variable lisp variables + hc-completing-insert-kill contents of kill ring + hc-completing-insert-buffer-contents buffer contents + hc-ispell-complete-word words, using ispell +@end verbatim + +These functions can be used anywhere, not just in the minibuffer. + +@node highlight-current-line, home-end, highlight-completion, Top +@chapter highlight-current-line.el - highlight line where the cursor is + +This is a minor mode to highlight the line the cursor is in. You can +change colors of foreground (text) and background. The default +behaviour is to set only a background color, so that font-lock +fontification colors remain visible (syntax coloring). + +Enable it on a buffer using @code{M-x highlight-current-line-minor-mode} or +globally by customizing @code{highlight-current-line-globally}. Customize +it via the @code{highlight-current-line} customization group. + +You can select whether the whole line (from left to right window border) +is marked or only the really filled parts of the line (from left window +border to the last char in the line). The second behaviour is suitable +if it's important for you to see trailing spaces or tabs in a +line. Customize the variable @code{highlight-current-line-whole-line}. + +You may enable the minor-mode automatically for (almost) all buffers by +customizing the variable @code{highlight-current-line-globally}. Buffers +whose buffer-name match the regular expression in the customizable variable +@code{highlight-current-line-ignore-regexp} are not highlighted. You can +extend or redefine this regexp. This works together with the default ignore +function @code{highlight-current-line-ignore-function}. You can redefine this +function to implement your own criterias. + +@node home-end, htmlize, highlight-current-line, Top +@chapter home-end - Alternative Home and End key commands + +Some useful bindings for Home and End keys: +@itemize @bullet +@item Hit the key once to go to the beginning/end of a line, +@item hit it twice in a row to go to the beginning/end of the window, +@item three times in a row goes to the beiginning/end of the buffer. +@end itemize + +To enable it, customize the variable @code{home-end-enable}. + +@node htmlize, joc-toggle-buffer, home-end, Top +@chapter htmlize - HTML-ize font-lock buffers + +@noindent Author: Hrvoje Niksic + +@noindent Commands: + +@table @samp +@item htmlize-buffer +Convert BUFFER to HTML, preserving colors and decorations. +@item htmlize-region +Convert the region to HTML, preserving colors and decorations. +@item htmlize-file +Load FILE, fontify it, convert it to HTML, and save the result. +@item htmlize-many-files +Convert FILES to HTML and save the corresponding HTML versions. +@item htmlize-many-files-dired +HTMLize dired-marked files. +@end table + +This package converts the buffer text and the associated +decorations to HTML. Mail to to discuss +features and additions. All suggestions are more than welcome. + +To use this, just switch to the buffer you want HTML-ized and type +@code{M-x htmlize-buffer}. You will be switched to a new buffer that +contains the resulting HTML code. You can edit and inspect this +buffer, or you can just save it with @key{C-x C-w}. @code{M-x htmlize-file} +will find a file, fontify it, and save the HTML version in +FILE.html, without any additional intervention. @code{M-x +htmlize-many-files} allows you to htmlize any number of files in +the same manner. @code{M-x htmlize-many-files-dired} does the same for +files marked in a dired buffer. + +htmlize supports two types of HTML output, selected by setting +@code{htmlize-output-type}: @code{css} and @code{font}. In @code{css} mode, htmlize +uses cascading style sheets to specify colors; it generates classes +that correspond to Emacs faces and uses ... +to color parts of text. In this mode, the produced HTML is valid +under the 4.01 strict DTD, as confirmed by the W3C validator. In +@code{font} mode, htmlize uses ... to colorize +HTML, which is not standard-compliant, but works better in older +browsers. @code{css} mode is the default. + +You can also use htmlize from your Emacs Lisp code. When called +non-interactively, @code{htmlize-buffer} and @code{htmlize-region} will +return the resulting HTML buffer, but will not change current +buffer or move the point. + +I tried to make the package elisp-compatible with multiple Emacsen, +specifically aiming for XEmacs 19.14+ and GNU Emacs 19.34+. Please +let me know if it doesn't work on some of those, and I'll try to +fix it. I relied heavily on the presence of CL extensions, +especially for cross-emacs compatibility; please don't try to +remove that particular dependency. When byte-compiling under GNU +Emacs, you're likely to get lots of warnings; just ignore them. + +@noindent The latest version should be available at: + + http://fly.srk.fer.hr/~hniksic/emacs/htmlize.el + +@noindent You can find a sample of htmlize's output (possibly generated with +an older version) at: + + http://fly.srk.fer.hr/~hniksic/emacs/htmlize.el.html + +Thanks go to the multitudes of people who have sent reports and +contributed comments, suggestions, and fixes. They include Ron +Gut, Bob Weiner, Toni Drabik, Peter Breton, Thomas Vogels and many +others. + +@verbatim +User quotes: "You sir, are a sick, sick, _sick_ person. :)" + -- Bill Perry, author of Emacs/W3 +@end verbatim +@node joc-toggle-buffer, joc-toggle-case, htmlize, Top +@chapter joc-toggle-buffer - flips back and forth between two buffers + +@noindent Author: Joe Casadonte + +This package provides a way to toggle back and forth between the last +two active buffers, without any extra keystrokes (like accepting the +default argument to @command{switch-to-buffer}). + +@noindent Usage: + +@noindent Commands: + +@table @samp +@item joc-toggle-buffer + Switched to the previous active buffer (when @command{switch-to-buffer} was + called). If there is no previous buffer, or if the buffer no longer + exists, a message will be displayed in the minibuffer. +@end table + +@noindent Nut & Bolts: + +This package works by advising @command{switch-to-buffer}, so if your +favorite buffer switching command does not ultimately call +@command{switch-to-buffer}, this won't work. Packages that alter the +current buffer *before* @command{switch-to-buffer} is called will also not +work properly. Both of these situations may be salvagable with +the addition of more advice. In the first case, just write a bit +of advice which essentially duplicates what I'm doing here with +@command{switch-to-buffer}. + +I've provided a hack (and a "hook") to help with the second +situation. The hack is to define a second variable (the "hook") +before the list is altered. Once @command{switch-to-buffer} is called, +the advice provided in this package will first look for this +hook/hack variable and use its value; if that's not found, it will +use the value returned by @code{buffer-name}. + +An example of this is the @code{swbuff} package, which changes the +current buffer before switching to the next one (though I'm not +sure why it does this). Since I use swbuff, I've included its +hack along with this package. You can customize whether or not +this hack is loaded (see Customization below). + + +@noindent Customization: + +@command{M-x customize-group joc-toggle-buffer} to customize all +package options. + +The following variable can be customized: + +@table @samp +@item joc-toggle-buffer-swbuff-advice + A hack to be compatable with the swbuff package. + + Valid values are: +@itemize @bullet +@item Never Advise - never advise the swbuff functions [nil] +@item Advise if Provided - only advise if swbuff already provided [P] +@item Always Advise - always define & activate the swbuff advise [A] +@end itemize + + If you don't use the swbuff package, you can safely choose + Never Advise or Advise if Provided. If you do use swbuff, you + may use Advise if Provided (in which case swbuff must be + `provide'd already) or Always Advise." +@end table + +@node joc-toggle-case, keydef, joc-toggle-buffer, Top +@chapter joc-toggle-case - toggles case at point like ~ in vi + +This packages provides a sophisticated (over-engineered?) set of +functions to toggle the case of the character under point, with which +you can emulate vi's ~ function, which I found useful and miss. +Basically, the vi command (and my version of it) toggles the case of +the current character and then advances to the next character, +allowing successive invocations to progress down the line. + +@noindent Commands: + +@table @samp +@item joc-toggle-case +Toggles the case of the character under point. If called with +a prefix argument, it toggles that many characters (see +@code{joc-toggle-case-stop-at-eol}). If the prefix is negative, the +case of the character before point is toggled, and if called +with a prefix argument, N characters before point will have +their case toggled (see also @code{joc-toggle-case-backwards}). +@item joc-toggle-case-backwards +Convenience function to toggle case of character preceeding +point. This is the same as calling @command{joc-toggle-case} with a +negative prefix (and is in fact implemented that way). +@item joc-toggle-case-by-word +Similar to @command{joc-toggle-case} except that the count (supplied by +the prefix argument) is of the number of words, not letters, to +be toggled. It will start from point and move to the end of +the first word at a minimum, and then take whole words from +there. If called with a negative prefix, then from point to +beginning of current word will have their case toggled, going +backwards for N words (see also +@code{joc-toggle-case-by-word-backwards}). Note that the +joc-toggle-case-stop-at-eol setting will be honored. +@item joc-toggle-case-by-word-backwards +Convenience function to toggle case by word, backwards. This +is the same as calling @command{joc-toggle-case-by-word} with a +negative prefix (and is in fact implemented that way). +@item joc-toggle-case-by-region +Toggles the case of all characters in the current region. +@end table + +@noindent Customization: + +Use @command{M-x customize-group joc-toggle-case} to customize all +package options. + +The following variable can be customized: + +@table @samp +@item joc-toggle-case-stop-at-eol + Boolean used to determine whether or not the toggle + advancement stops at the end of a line. Set to `t' it will + stop at the end of the line, set to `nil' it will not (it + will continue on to the next line). If direction of toggle + is reversed, the semantics of this are reveresed as well + (i.e. does it stop at the beginning of the line). +@end table + +@noindent Keybinding examples: + +This is what I have -- use it or not as you like. + +@verbatim + (global-set-key [(control \`)] 'joc-toggle-case) + (global-set-key [(control ~)] 'joc-toggle-case-backwards) + + (global-set-key [(control meta \`)] 'joc-toggle-case-by-word) + (global-set-key [(control meta ~)] 'joc-toggle-case-by-word-backwards) + + (define-key joc-F3-keymap [(\`)] 'joc-toggle-case-by-region) +@end verbatim + +I have a special @key{F3} keymap which this last one is bound to. +Email me if you'd like more details. + +@node keydef, keywiz, joc-toggle-case, Top +@chapter keydef - a simpler way to define keys, with kbd syntax + +@noindent Author: Michael John Downes + +The macro keydef provides a simplified interface to define-key that +smoothly handles a number of common complications. + +The global-set-key command isn't ideal for novices because of its +relatively complex syntax. And I always found it a little +inconvenient to have to quote the name of the command---that is, I +tend to forget the quote every once in a while and then have to go +back and fix it after getting a load error. + +One of the best features is that you can give an Emacs lisp form (or +even a series of forms) as the key definition argument, instead of a +command name, and the keydef macro will automatically add an +interactive lambda wrapper. I use this to get, for example, a more +emphatic kill-buffer command (no confirmation query) by writing + +@verbatim + (keydef "" (kill-buffer nil)) +@end verbatim + +For keydef the key sequence is expected to be given uniformly in the +form of a string for the 'kbd' macro, with one or two refinements +that are intended to conceal from users certain points of confusion, +such as (for those whose keyboards lack a Meta key) the whole +Meta/ESC/escape muddle. + +I have had some trouble in the past regarding the distinction +between ESC and [escape] (in a certain combination of circumstances +using the latter form caused definitions made with the other form to +be masked---most puzzling when I wasn't expecting it). Therefore the +ESC form is actually preprocessed a bit to ensure that the binding +goes into esc-map. + +There is one other special feature of the key sequence syntax +expected by the keydef macro: You can designate a key definition for +a particular mode-map by giving the name of the mode together with +the key sequence string in list form, for example + +@verbatim + (keydef (latex "C-c %") comment-region) +@end verbatim + +This means that the key will be defined in latex-mode-map. [The +point of using this particular example will be made clear below.] I +arranged for the mode name to be given in symbol form just because I +didn't want to have to type extra quotes if I could get away with +it. For the same reason this kind of first arg is not written in +dotted pair form. + +If the given mode-map is not defined, keydef "does the right thing" +using eval-after-load. In order to determine what library the +mode-map will be loaded from, it uses the following algorithm: + +First check if foo-mode has autoload information. If not, check +whether "foo-mode" is the name of a library that can be found +somewhere in the load-path (using locate-library); otherwise check +whether "foo" is the name of a locatable library. Failing that, give +up and return nil. + +There is a fall-back mechanism, however, to handle exceptional +cases. If foo-mode-map is undefined but the list mode-map-alist +contains an entry of the form (foo-mode-map foo-other-name-map), +then foo-other-name-map is used as the name of the +keymap. + +If the mode-map is not loaded yet AND the command being bound to a +key is undefined at the time of the keydef assignment, it presents +further problems. The simplest solution is to assume that after the +package is loaded that defines the mode-map, the given command will +be defined and satisfy commandp. With some extra effort it should be +possible to determine more accurately whether the command will be +defined or not, but I'm not sure I want to go to that extreme, since +as far as I can see it would require opening the package file and +searching through it for a matching defun/defalias/fset statement. + +If the mode name matches the mode map name, but foo-mode is not +autoloaded, then some autoload information may need to be provided. +For example, the following line allows definitions to be made for +debugger-mode-map even before debug.el is loaded. + +@verbatim + (autoload 'debugger-mode "debug" "Autoloaded." 'interactive) +@end verbatim + +Although there is no easy way provided by keydef for +gnus-summary-limit-map to be accessed directly, because +its name does not include "mode", you can get a binding into +such a map by writing + +@verbatim + (keydef (gnus-summary "/ z") gnus-summary-limit-to-zapped) +@end verbatim + +which binds /z in gnus-summary-mode-map, which is equivalent to +binding z in gnus-summary-limit-map. + +You might need to add an autoload statement for gnus-summary-mode +in order for this to work, so that keydef knows that it should use +eval-after-load and that the file the mode function will be loaded +from is called "gnus-sum" rather than "gnus-summary-mode". (If it +were the latter, keydef would be able to resolve everything +automatically.) + +We COULD HAVE just put the definitions into the mode hook in the +standard way, instead of using eval-after-load, but that would mean +the key definitions get executed repetitiously every time the mode +function gets called, which seems better to avoid, if only for +esthetic reasons (if it can be done without too much trouble). + +The following examples show some typical keydef lines followed by the +results of the macro expansion. + +@noindent Simplest kind of definition: + +@verbatim +(keydef "C-x m" gnus-group-mail) + + -->(define-key global-map (kbd "C-x m") (quote gnus-group-mail)) +@end verbatim + +@noindent What if the command name is misspelled? + +@verbatim +(keydef "C-x m" gnus-gruop-mail) + + -->(message "keydef: gnus-gruop-mail unknown \ + \(perhaps misspelled, or not loaded yet\)") +@end verbatim + +@noindent A leading ESC gets special handling to go through esc-map. + +@verbatim +(keydef "ESC &" query-replace-regexp) + + -->(define-key esc-map (kbd "&") (quote query-replace-regexp)) +@end verbatim + +@noindent Undefine a key: + +@verbatim +(keydef "ESC `") + + -->(define-key esc-map (kbd "`") nil) +@end verbatim + +@noindent If the second arg is a string, keydef defines the given key sequence +as a keyboard macro. The following macro puts in TeX-style double +quotes and then moves the cursor backward to leave it in the middle: + +@verbatim +(keydef "\"" "``''\C-b\C-b") + + -->(define-key global-map (kbd "\"") "``''\002\002") +@end verbatim + +@noindent Reset a key to self-insert + +@verbatim +(keydef "\"" "\"") + + -->(define-key global-map (kbd "\"") (quote self-insert-command)) +@end verbatim + +@noindent If the second arg is a list, wrap it in an interactive lambda form. + +@verbatim +(keydef "C-z" + (message "Control-Z key disabled---redefine it if desired.")) + + -->(define-key global-map + (kbd "C-z") + (lambda (arg) + "anonymous keydef function" + (interactive "p") + (message "Control-Z key disabled---redefine it if desired."))) +@end verbatim + +Note that the interactive lambda wrapper added by keydef, when the +CMD does not satisfy commandp, always takes a single prefix argument +named "arg", which is read in the usual way with (interactive "p"); +so this could be used in the body of the function if need be. + +@noindent This shows the notation for F-keys. + +@verbatim +(keydef "" (kill-buffer nil)) + + -->(define-key global-map + (kbd "") + (lambda (arg) + "*Anonymous function created by keydef." + (interactive "p") + (kill-buffer nil))) +@end verbatim + +Because of the confusing Meta/Escape complications, I recommend to +the users that I support that they use the ESC notation +consistently if that is what they type from their keyboard, even +for F-key definitions that might normally be written with +notation. + +@verbatim +(keydef "ESC " find-file-read-only) + + -->(define-key esc-map (kbd "") (quote find-file-read-only)) +@end verbatim + +@noindent The next two definitions go together. The second one shows how to +write a mode-specific definition. + +@verbatim +(keydef "" isearch-forward) + + -->(define-key global-map (kbd "") (quote isearch-forward)) + +(keydef (isearch "") isearch-repeat-forward) + + -->(define-key isearch-mode-map (kbd "") + (quote isearch-repeat-forward)) +@end verbatim + +@noindent Making a definition for a mode-map that is not loaded yet. + +@verbatim +(keydef (latex "C-c %") comment-region) + + -->(eval-after-load "tex-mode" + (quote + (define-key latex-mode-map + (kbd "C-c %") + (quote comment-region)))) +@end verbatim + +@node keywiz, lcomp, keydef, Top +@chapter keywiz - Emacs key sequence quiz + +@noindent Author: Jesper Harder + +keywiz.el drills you about Emacs key-bindings. You're presented +with the name of a command and the docstring, and then prompted for +the correct key sequence. You'll earn one point for each correct +answer during the time limit. + +Invoke with @command{M-x keywiz}. A prefix argument will force keywiz +to rescan the key-binding -- this is useful if you want to include +bindings from a different mode. + +Are you a true Emacs key-binding wizard or just a poor vi looser? +Get your foot-pedals in position and see how many key-bindings you +can remember in two minutes. + +Forget about your Nethack high-score -- surely, knowing how to +wield the powers of the One True Editor at your fingertips will +earn you more bragging rights than ascending bare-footed in some +silly game with vi-keybindings :-) + +@node lcomp, maplev, keywiz, Top +@chapter lcomp - list-completion hacks + +@noindent Author: Taiki SUGAWARA + +This package adds keybindings to the completions buffer: + +@table @kbd +@item \C-i +next-completion +@item \M-\C-i +previous-completion +@item f +next-completion +@item b +previous-completion +@item n +next-line +@item p +previous-line +@item +scroll-up +@item [del] +scroll-down +@item [backspace] +scroll-down +@item q +delete-completion-window +@end table + +@noindent It also add and a global keybinding: + +@table @kbd +@item \M-v +lcomp-select-completion-window-or-scroll-down +@end table + +You may also enable advice to other Emacs functions to make the +completions buffer window disappear after use by putting this line +into your ~/.emacs. + +@example + (lcomp-activate-advices t) +@end example + +Or alternatively, customize the group @code{lcomp} and then the +variable @code{lcomp-enable} and save the the setting for future sessions. + +@node maplev, map-lines, lcomp, Top +@chapter maplev - Maple major mode + +@noindent Authors: Joseph S. Riel and Roland Winkler + +To use this Maple major mode, you must customize some of the default +settings to be appropriate for your installation. You can do this in +several ways. The most user friendly way is to use `customize'. You +can do this with: + +@example +@kbd{M-x} customize-group @key{RET} maplev @key{RET} +@end example + +The important options are in the subgroup @code{maplev-important}. After +setting and testing these options, save them to your .emacs by +clicking on the @code{Save for Future Sessions} button. + +This mode has full documentation in it's own Info manual. +See @inforef{top, MapleV mode info node, maplev}. + +@node map-lines, markdown-mode, maplev, Top +@chapter map-lines - Map a command over many lines + +@noindent Author: Andreas Fuchs + +This module allows you to map a command over a set of lines +matching a regex. The trick: You can then go ahead and insert these +lines in one clean yank. It's good for kill a bunch of lines in one +go, or collecting a bunch of lines in the kill-ring ready to paste. + +@verbatim +Emacs can now be called ED, THE STANDARD TEXT EDITOR + +@end verbatim + +Invoke it with @command{M-x map-lines}. + +@node markdown-mode, marker-visit, map-lines, Top +@chapter markdown-mode - Major mode for editing Markdown files + +This was removed from emacs-goodies-el V36.0 because it is packaged +separately as elpa-markdown-mode. + +@node marker-visit, matlab, markdown-mode, Top +@chapter marker-visit - navigate through a buffer's marks in order + +@noindent Benjamin Rutt + +This file provides a simple way to navigate among marks in a +buffer. @key{C-u C-SPC} is similar, but takes you haphazardly around the +buffer. Setting bookmarks is a lot of extra work if you just want +to jump around your buffer quickly; plus, you have to come up with +a name for every bookmark. + +All the marks you've left while editing a buffer serve as bread +crumb trails of areas in the buffer you've edited. It is +convenient to navigate back and forth among these marks in order. +This file provides two methods to do just that, @command{marker-visit-prev} +and @command{marker-visit-next}. These two functions will take you, from +point, to the nearest mark in either direction. The function +@command{marker-visit-truncate-mark-ring} will truncate the mark ring. + +The marks you can visit in a buffer consist of: "the mark" plus the +contents of the mark-ring. + +This package is most useful when some easy-to-press keys are bound to +the functions @command{marker-visit-prev} and +@command{marker-visit-next}. See @key{C-h i m Emacs RET m Key Bindings RET} +for info on emacs key bindings. + +@node matlab, minibuf-electric, marker-visit, Top +@chapter matlab - Major mode for MATLAB dot-m files + +@noindent Authors: Matt Wette , Eric M. Ludlam + +@noindent http://www.mathworks.com/access/pub/emacs_add_ons.zip + +This major mode for GNU Emacs provides support for editing MATLAB dot-m +files. It automatically indents for block structures, line continuations +(e.g., ...), and comments. + +The default mode for files with the extension .m is c-mode, and so +this is not overriden here. To use this mode, either invoke it each +time with: + +@example + M-x matlab-mode +@end example + +or insert the following snippet of code in your @file{.emacs} file. + +@example + (add-to-list 'auto-mode-alist '("\\.m$" . matlab-mode)) +@end example + +or, in Debian, customize the variable @code{matlab-auto-mode} to +associated the .m file extention to matlab-mode. + +Additional features include auto-fill including auto-additions of +ellipsis for commands, and even strings. Block/end construct +highlighting as you edit. Primitive code-verification and +identification. Templates and other code editing functions. +Advanced symbol completion. Code highlighting via font-lock. +There are many navigation commands that let you move across blocks +of code at different levels. + +Lastly, there is support for running Matlab in an Emacs buffer, +with full shell history and debugger support (when used with the db +commands.) The shell can be used as an online help while editing +code, providing help on functions, variables, or running arbitrary +blocks of code from the buffer you are editing. + +@node minibuf-electric, minibuffer-complete-cycle, matlab, Top +@chapter minibuf-electric.el - Electric minibuffer behavior from XEmacs + +This works with GNU Emacs. It implements the XEmacs minibuffer behavior +for @key{C-x C-f} and other file name reading actions. When you type +@key{/} twice, it clears the minibuffer back to the start, leaving only +a single @code{/}. When you type a @key{~}, it does the similar, +leaving only @code{~/}. This is nicer than having to explicitly erase +the contents of the minibuffer. + +In the next GNU Emacs release (V22), the following will achieve this: + +@example + (setq file-name-shadow-tty-properties '(invisible t)) + (file-name-shadow-mode 1) +@end example + +@node minibuffer-complete-cycle, miniedit, minibuf-electric, Top +@chapter minibuffer-complete-cycle - cycle through the *Completions* buffer + +@noindent Author: Kevin Rodgers + +The @command{minibuffer-complete} command, bound by default to TAB in the +minibuffer completion keymaps, displays the list of possible +completions when no additional characters can be completed. +Subsequent invocations of this command cause the window displaying +the *Completions* buffer to scroll, if necessary. + +This library advises the @command{minibuffer-complete} command so that +subsequent invocations instead select each of the possible +completions in turn, inserting it into the minibuffer and +highlighting it in the *Completions* buffer. As before, the window +displaying the possible completions is scrolled if necessary. + +This feature is enabled by setting the +@code{minibuffer-complete-cycle} variable to @code{t} with +@command{M-x customize-group minibuffer-complete-cycle} or +@command{M-x set-variable}; it is disabled by unsetting the option (to +nil). Besides @code{t}, the special value @code{auto} enables the +feature and also causes the first completion to be selected +immediately. + +You can also customize the @code{minibuffer-complete-cycle} face, which is +used to highlight the selected completion. + +The technique of deleting the minibuffer contents, then (for file +name completion) inserting the directory component of the initial +input, and then inserting the completion string itself is based on +cycle-mini.el (1.03) by Joe Reiss . + +@node miniedit, mutt-alias, minibuffer-complete-cycle, Top +@chapter miniedit - enhanced editing for minibuffer fields + +@noindent Authors: Deepak Goel , Christoph Conrad < christoph.conrad@@gmx.de> + +miniedit adds a key @key{C-M-e} (e for edit) to the +minibuffer-local-map, and other similar maps, and binds it to the +function miniedit. This means that when you are in a minibuffer, trying +to enter something, you can type @key{C-M-e} to go enter those fields in +a nice full buffer (with text mode) instead. In particular, inserting +new lines and indenting is easy.. Helpful, for instance, when editing +bbdb notes fields, which tend to be multiline, (right?). Type +@key{M-C-c} or @key{C-c C-c} when done. + +Installation can be done by customizing the variable +@code{miniedit-install-p} and saving the setting, or by inserting +@example + (miniedit-install) +@end example + +in their ~/.emacs file (XEmacs users should enter +@command{(miniedit-install-for-xemacs)} instead. + +@node mutt-alias, muttrc-mode, miniedit, Top +@chapter mutt-alias - Lookup/insert mutt mail aliases. + +@noindent Author: Dave Pearson + +mutt-alias allows you to lookup and insert the expansion of mutt mail +aliases. This is only handy if you use mutt @url{http://www.mutt.org/}. + +The following commands are available: + +@table @samp +@item mutt-alias-insert +Insert the expansion for ALIAS into the current buffer. +@item mutt-alias-lookup +Lookup and display the expansion for ALIAS. +@end table + +@node muttrc-mode, obfusurl, mutt-alias, Top +@chapter muttrc-mode - Major mode to edit muttrc under Emacs + +@noindent Author: Laurent Pelecq + +This mode first goal is to provide syntax highlighting with +font-lock. The basic fontification appears on strings, comments, +command names and variables. Additional fontification for commands +arguments can be enabled through the customization buffer. + +To customize it, execute @command{M-x customize-group RET muttrc RET} + +By default, help on command/variable is displayed automatically +while executing a command to modify them. Disable this feature if +you have problems with. + +The main commands are: + +@table @samp +@item C-x c +muttrc-insert-command +@item C-x s +muttrc-set-variable +@item C-x S +muttrc-unset-variable +@end table + +Type @key{C-h m} for all key bindings. + +@noindent BUGS: + +Multiline commands are not properly handled and can lead to unexpected +result. + +@node obfusurl, pack-windows, muttrc-mode, Top +@chapter obfusurl - Obfuscate URLs so they aren't spoilers + +@noindent Author: Dave Pearson + +obfusurl.el provides @command{obfuscate-url}, a command that will obfuscate an +URL under the cursor. This might be useful if you are writing out an URL +for someone but the URL itself might spoil the surprise. + +@noindent For example, this: + +@example + +@end example + +is turned into this: + +@example + +@end example + +@node pack-windows, perldoc, obfusurl, Top +@chapter pack-windows - resize all windows to display as much info as possible. + +@noindent Author: Michel Schinz + +Resize all windows vertically to display as much information as possible +with the command @command{M-x pack-windows}. + +Only windows that are on the left edge of the frame are taken into +account. The vertical space available in the frame is first divided +among all these windows. Then any window requireing less lines than it +got to display its whole buffer is shrinked, and the freed space is +divided equally among all the other windows. + +If some vertical space remains afterwards, it is given in totality to +the currently selected window. + +Do not shrink any window to less than @code{window-min-height}. + +Shrink windows iteratively, performing at most +@code{pack-windows-max-iteration} iterations. The number of iterations +really performed will be displayed in the echo area if +@code{pack-windows-verbose} is non-nil. These two variables can be +customized with @command{M-x customize-group pack-windows}. + +@node perldoc, pp-c-l, pack-windows, Top +@chapter perldoc - Show help for Perl functions, builtins, and modules. + +@noindent Author: Steve Kemp + +This package allows the user to view the Perl help for the word(s) at +the point. + +Customize the variable @code{perldoc-define-F1} to @code{on} to bind +the key @key{F1} to show point for the item under point in +@code{cperl-mode} and @code{perl-mode}. + +The code handles functions, builtins, and third party modules. + +@node pp-c-l, pod-mode, perldoc, Top +@chapter pp-c-l - Display Control-l characters in a pretty way. + +@noindent Author: Drew Adams + +pp-c-l, also called Pretty-Control-L, displays end-of-page charcaters +(@code{C-L}) in a pretty way. + +To turn on this mode by default, then either customize option +@code{pretty-control-l-mode} to non-nil and save it, or add this +line also to your init file: + +@example + (pretty-control-l-mode 1) ; Turn on pretty display of `^L'. +@end example + +If you change the value of most of the customizaions, then you will need +to re-enter @code{pretty-control-l-mode} for the new value to take +effect. + +@node pod-mode, projects, pp-c-l, Top +@chapter pod-mode - major-mode for editing Plain Old Documentation files + +@noindent Author: Steffen Schwigon + +Provides font-locking for editing POD (Plain Old Documentation) files. + +@node projects, protbuf, pod-mode, Top +@chapter projects - Project-based buffer name management + +@noindent Author: Erik Naggum + +Managing a large number of buffers that visit files in many directories +(such as both local and remote copies of sources) can be confusing when +there are files with similar or even identical names and the buffers end +up being named foobar.cl<19> or like unintuitiveness. This package +introduces the concept of PROJECT ROOTS that allow the programmer to +define what looks suspiciously like logical pathname hosts from Common +Lisp and get abbreviated yet meaningful buffer names in the modeline. + +Commands include @code{project-add}, which takes a project name and a directory +(which conveniently defaults to the current directory), @code{project-remove} +(which completes on existing projects), and @code{project-list}, which lists the +current projects in a rudimentary table. @code{project-update-buffer-names} is +called automatically when either @code{project-add} or @code{roject-remove} changes +the project list, but may also be called by the user as a command. + +Variables include @code{project-root-alist}, which contains the list of current +projects and their root directories, and two variables that control the +naming of buffers: @code{project-buffer-name-directory-limit}, the uppper limit +on the number of characters in the last few directory elements in the +pathname that makes up the buffer name and +@code{project-buffer-name-directory-prefix}, the string prepended to buffer +names that would be too long. + +Internal functions include @code{project-buffer-name}, which computes the +buffer name from the filename argument, @code{project-root-alist}, which +computes a sorted list of projects on their directories and maintains a +cache because this operation is expensive, and a redefinition of the +function @code{create-file-buffer}, which is called to create new file-visiting +buffers. Note that the latter may still produce ..., if truly +identical buffer names are requested. This may happen if you call dired +on a filename and then visit the same file. Use @key{C-x C-v M-p} instead. + +This file is modified on Debian by Peter Galbraith. I like the concept +of prefixing certain buffer names with a project name, but not +renaming all unrelated buffers with the full directory path. This +breaks MH-E mail folder names for example. So I'm introducing the +variable @code{project-rename-all-buffers} with a default of nil. You may +customize this to obtain the old behaviour. + +@node protbuf, protocols, projects, Top +@chapter protbuf - Protect buffers from accidental killing + +@noindent Author: Noah Friedman + +This package allows you to make it harder to kill buffers accidentally, +e.g. by being too trigger happy selecting items in the buffer menu. + +@noindent The commands are: + +@table @samp +@item protect-buffer-from-kill-mode +Toggle @code{kill-buffer} protection on current buffer. +@item protect-process-buffer-from-kill-mode +Toggle @code{kill-buffer} protection on current buffer with active process. +@end table + +@command{protect-process-buffer-from-kill-mode} is perhaps the more +useful of the two, making it harder to accidentally kill shell buffers +without terminating the process in them first. + +@node protocols, quack, protbuf, Top +@chapter protocols - Protocol database access functions. + +@noindent Author: Dave Pearson + +This package (protocols.el) provides a set of functions for accessing +the protocol details list. + +@noindent Commands: + +@table @samp +@item protocols-lookup +Find a protocol and display its details. +@item protocols-clear-cache +Clear the protocols \"cache\". +@end table + +@node quack, rfcview, protocols, Top +@chapter quack - Enhanced support for editing and running Scheme code + +@noindent Author: Neil W. Van Dyke + +Quack enhances Emacs support for Scheme programming. Quack is layered +atop the standard packages `cmuscheme.el', by Olin Shivers, and +`scheme.el', by Bill Rozas and Dave Love. Added features include: + +To use it, customize the variable @code{quack-install}. + +@itemize @bullet +@item Menu and commands for viewing popular Scheme-related manuals or +books. Uses local copies of PLT manuals when available, and remote +Web copies when necessary. Command for keyword lookup in PLT +manual, with keyword defaulting to symbol at point. + +@item Menus and command for viewing SRFIs. SRFI index information is +automatically downloaded from SRFI Web site. Prompt defaults to +SRFI number referenced at point. + +@item A `find-file' alternative that defaults to the file corresponding to +the PLT `require' form at point. (Other module systems will be +supported in future versions of Quack.) + +@item Two new sets of font-lock rules for Scheme: "PLT Style," which is +similar to that used by DrScheme 200 Check Syntax; and "Extended GNU +Emacs Style," which is an extended version of the standard Scheme +font-lock rules under GNU Emacs. + +@item Pretty-lambda fontification. (GNU Emacs 21 only.) + +@item Enhanced `run-scheme' behavior. + +@item Enhanced `switch-to-scheme' behavior. + +@item Scheme Mode indentation rules for extensions of PLT, Guile, and +other dialects. + +@item Command to toggle a `define' form between `(define ( ) +)' and `(define (lambda () ))' syntax. + +@item Command for tidying the formatting in a Scheme Mode buffer. + +@item The `)' and `]' keys insert the character that agrees with the +s-expression's opening character. + +@item Automatic indenting options for Return key. + +@item Mode for inspecting contents of PLT `.plt' package files, before +releasing or installing the packages, or if one does not have PLT +available. + +@item Command to open a Dired on a specified PLT collection. + +@item `compile' mode can navigate from PLT `setup-plt' errors. +@end itemize + +@noindent The name "Quack" was a play on "DrScheme". + +@noindent Quack is dedicated to Yosh, naturally. + +@noindent Commands: + +@key{C-c C-q m} View a manual in your Web browser. + +@key{C-c C-q k} View the manual documentation for a keyword + +@key{C-c C-q s} View an SRFI. + +@key{C-c C-q r} Run an inferior Scheme process. + +@key{C-c C-q f} Find a file using context of point for default. + +@key{C-c C-q l} Toggle `lambda' syntax of `define'-like form. + +@key{C-c C-q t} Tidy the formatting of the buffer. + +One additional command that does not currently have a standard binding +is `quack-dired-pltcollect', which prompts for a PLT collection name and +creates a Dired buffer on the collection's directory. (A future version +of Quack may integrate this functionality into a more generalized +documentation navigation interface.) + +@node rfcview, services, quack, Top +@chapter rfcview - view IETF RFCs with readability-improved formatting + +@noindent Author: Neil W. Van Dyke + +For historical reasons, IETF Internet RFCs are required to be in a plain +ASCII text format that's best-suited for sending directly to a 6-lpi +US-letter-size printer. This makes them suboptimal for viewing on-screen, +as you will be doing for countless hours if you're ever doing network +programming to one of them. Fortunately, the ASCII format is usually +close to what you, the Emacs zealot, *truly* want -- which is a format +suited to more pleasurably viewing the RFC in Emacs. + +The `rfcview' package uses Emacs overlays to add some fontification and +hide the page headers and footers (which it replaces with one-line page +number references that look like "(p.1)", right-justified). The file is +never modified, and you can see the raw ASCII text by pressing `t'. + +You may customize some aspects of this package using @command{M-x +customize-group rfcview}. + +The emacs-goodies-el package sets up Emacs to enter +@command{rfcview-mode} automatically when reading such a file (as +recognised by the filename). + +@node services, session, rfcview, Top +@chapter services - Services database access functions. + +@noindent Author: Dave Pearson + +This package (services.el) provides a set of functions for accessing +the services details list. + +@node session, setnu, services, Top +@chapter session - Session Management for Emacs + +When you start Emacs, package Session restores various variables (e.g., +input histories) from your last session. It also provides a menu containing +recently changed/visited files and restores the places (e.g., point) of +such a file when you revisit it. + +To enable this package, customize the group @code{session} and within +it the variable @code{session-initialize} and save the settings. + +To restore the variables, this package writes a session file (~/.session) +when you exit Emacs. The file includes the values of variables which are +automatically updated by Emacs during some editing operations: + +@itemize @bullet +@item Histories of user input. For example, strings used in a find/replace +command, names of files you have visited, etc. + +@item Contents of registers, whether they are texts or buffer/file +positions. Buffer positions are automatically converted to file positions. + +@item List of recently copied/cut text blocks to paste, global markers to +jump to, and other so-called rings. + +@item List of recently changed files with their places and some buffer-local +variables. +@end itemize + +To restore the places of a recently changed/visited file when you revisit +it, this packages stores the places of a buffer in a special variable (the +list mentioned above) when you kill that buffer (this includes exiting +Emacs). Places are: + +@itemize @bullet +@item Point (the cursor position) and mark (e.g., the opposite position +when a region is highlighted). These places will be restored, but a region +won't be made active. + +@item The position of the last change. A new command (bound to @key{C-x +C-/}) can be used to jump to that position. + +@item The boundaries if only a part of a buffer was visible. Reopening the +file will again restrict/narrow the editing operations to that region. + +@item Values of buffer-local variables. Useful for variables which control some +temporary editing behavior, e.g., overwrite-mode. +@end itemize + +As opposed to desktop.el and other packages, Session does not automatically +revisits all files from your last session, most of which are not +interesting anymore. + + +Details of Package Session + +@menu +* Session Menus and Key-Bindings:: +* Saving Session Variables:: +* Storing Buffer Places:: +@end menu + +@node Session Menus and Key-Bindings, Saving Session Variables, session, session +@section Session - Menus and Key-Bindings + +For Emacs-21.1+ and XEmacs, this package defines the following menu entries +and key-bindings: + +@itemize @bullet +@item +At the beginning of menu File, there are two new submenus: +@code{Open...recently changed} and @code{Open...recently visited}. + +@item +In menu Edit, there is a new submenu: @code{Select and Paste}, it already +exists in Emacs-21+. With XEmacs, using the right mouse button @key{C-button3} +also pops up this submenu. + +@item +Enter @key{C-x C-/} or @key{C-x Undo} to jump to the position of the last +change (use repeatedly or with prefix argument for earlier positions). + +@item +In the minibuffer, enter @key{M-?} to display a completion list with all +strings in the history for the current minibuffer input. From that list, +you can use @key{button2} to select an entry. + +@end itemize + +@node Saving Session Variables, Storing Buffer Places, Session Menus and Key-Bindings, session +@section Session - Saving Session Variables + +There are various ways to control which lists/variables are saved in the +session file and which elements in a list are included in the saved value: + +@itemize @bullet +@item The variables to store can be specified by a regular expression +matching their names, and by an include/exclude list. + +@item +Variables containing empty lists are not stored. You do not want to clutter +up your session file... + +@item +Long lists can be truncated. A maximum length can be specified globally and +individually for single variables. + +@item +If there are equal elements in the list, only the first is saved. Long +strings in a list can be excluded by specifying a maximal string length. + +@item +Elements in a list which have no readable representation (e.g., events in +the command history) are automatically dropped. + +@item +To exit Emacs without writing a session file, use prefix argument 0: enter +@key{C-u 0 C-x C-c}. + +@end itemize + +Technical detail: documentation of command session-save-session. + +Note: you cannot share the same session file between Emacs and XEmacs +(different coding systems, different types for the same variables, ?). + +@node Storing Buffer Places, , Saving Session Variables, session +@section Session - Storing Buffer Places + +Since not all buffers/files are of permanent interest, there are various +conditions and means to control for which buffers to store some places: + +@itemize @bullet +@item +The buffer must visit a readable file. There are variables to exclude or +include buffers due to their major mode or buffer file name. + +@item +By default, the contents must have been changed. You still have the places +from previous Emacs sessions, but that information is older and thus more +likely to be truncated from the list of saved buffer places (see above). + +@item +Individual control by providing a prefix argument to command @command{M-x +kill-this-buffer} (@key{C-u 2} or higher: store places, @key{C-u 0} or +lower: don't store places). + +@item +A file/buffer can be marked as permanent, i.e., its places will always be +stored. Use @command{M-x session-toggle-permanent-flag} or select the +corresponding menu item in the new submenu @code{Open...recently changed}. + +@end itemize + +@node setnu, shell-command, session, Top +@chapter setnu - vi-style line number mode for Emacs + +@noindent Author: Kyle E. Jones + +This package adds line numbers on the left margin of a buffer. +The numbers disappear when the mode is exited. + +@noindent Use @command{M-x setnu-mode} to toggle the line number mode +on and off. + +@noindent @command{turn-on-setnu-mode} is useful for adding to a +major-mode hook variable (not that you really want to do this). + +@example +Example: + (add-hook 'text-mode-hook 'turn-on-setnu-mode) +@end example +to automatically turn on line numbering when enterting text-mode." + +You may customize the group @code{setnu} and customize the face +@code{setnu-line-number-face} to change the appearance of the line numbers. + +@node shell-command, show-wspace, setnu, Top +@chapter shell-command - enables tab-completion for `shell-command' + +@noindent Author: TSUCHIYA Masatoshi + +This is an enhancement of shell-command, shell-command-on-region, +grep, grep-find, and compile, that enables tab-completion of +commands and dir/filenames within their input contexts. + +The latest version of this program can be downloaded from +http://namazu.org/~tsuchiya/elisp/shell-command.el. + +@noindent Install: + +Install this file to an appropriate directory, and put these lines +into your ~/.emacs. + +@example + (shell-command-completion-mode) +@end example + +Or alternatively, customize the group @code{shell-command} and then +the variable @code{shell-command-completion-mode} and save the setting +for future sessions. + +Note that setup has changed since Debian sarge for which the function +to call was @code{shell-command-activate-advices} and the variable to +customize was @code{shell-command-enable-completions}. + +@node show-wspace, slang-mode, shell-command, Top +@chapter show-wspace - highlight whitespaces of various kinds. + +You can use commands `show-ws-toggle-*' (see below) to turn the +various kinds of whitespace highlighting on and off in Font-Lock mode. + +If you want to always use a particular kind of whitespace +highlighting, by default, then add the corresponding `highlight-*' +command (see below) to the hook `font-lock-mode-hook'. Then, whenever +Font-Lock mode is turned on, so will the whitespace highlighting. + +For example, you can turn on tab highlighting by default by adding +command `show-ws-highlight-tabs' to `font-lock-mode-hook' in your +.emacs file, as follows: + +@example + (require 'show-wspace) + (add-hook 'font-lock-mode-hook 'show-ws-highlight-tabs) +@end example + +@noindent Faces: +@itemize +@item show-ws-hard-space +@item show-ws-tab +@item show-ws-trailing-whitespace +@end itemize + +@noindent Commands: +@itemize +@item show-ws-toggle-show-hard-spaces +@item show-ws-toggle-show-tabs +@item show-ws-toggle-show-trailing-whitespace +@item toggle-show-hard-spaces-show-ws (alias) +@item toggle-show-tabs-show-ws (alias) +@item toggle-show-trailing-whitespace-show-ws (alias) +@end itemize + +@noindent Non-interactive functions: +@itemize +@item show-ws-highlight-hard-spaces +@item show-ws-highlight-tabs +@item show-ws-highlight-trailing-whitespace +@end itemize + +@noindent Internal variables: +@itemize +@item show-ws-highlight-hard-spaces-p +@item show-ws-highlight-tabs-p +@item show-ws-highlight-trailing-whitespace-p +@end itemize + +@node slang-mode, silly-mail, show-wspace, Top +@chapter slang-mode - a major-mode for editing slang scripts. + +@noindent Authors: Gregor Schmid , Joe Robertson + +Slang-mode supports c-mode style formatting and sending of +lines/regions/files to a slang interpreter. An interpreter (see +variable @code{slang-default-application}) will be started if you try to +send some code and none is running. You can use the process-buffer +(named after the application you chose) as if it were an +interactive shell. See the documentation for @file{comint.el} for +details. + +To see all the keybindings for folding mode, look at +@code{slang-setup-keymap} or start @command{slang-mode} and type +@key{\C-h m}. The keybindings may seem strange, since I prefer to use +them with slang-prefix-key set to nil, but since those keybindings are +already used the default for @code{slang-prefix-key} is @key{\C-c}, +which is the conventional prefix for major-mode commands. + +You can customise the keybindings by setting @code{slang-prefix-key}. + +@node silly-mail, sys-apropos, slang-mode, Top +@chapter silly-mail - generate bozotic mail headers + +@noindent Maintainer: Noah Friedman + +This package generates bozotic mail headers. + +To use this, invoke @command{M-x sm-add-random-header} from a mail composition +buffer to insert a random header. You may call the command again to +substitute the inserted header by another. + +Use @command{M-x sm-delete-last-header} to remove it. + +If you wish all mail messages to have a randomly chosen header, put the +following in your @file{.emacs}: +@verbatim + (autoload 'sm-add-random-header "silly-mail" nil t) + (add-hook 'mail-setup-hook 'sm-add-random-header) + (add-hook 'mh-letter-mode-hook 'sm-add-random-header) +@end verbatim + + or alternatively customize the variable @command{sm-add-ramdom-header-to-mail}. + +@noindent To setup menu-bar entries in sendmail and MH-E menus, customize the +variable @code{sm-add-menu-bar-entries}. This has the disadvantage of +loading this library at Emacs startup, so might not be a good choice +if you rarely use silly-mail. + +You may customize silly-mail using @command{M-x customize-group [RET] +silly-mail}. The following are customizable: + +@itemize @bullet +@item +The list of header types used in the random selection by +@command{sm-add-random-header} +@item +Individual quotes may be disabled from the pool if some are offensive +to you. +@item +Whether all headers use an "X-" prefix or not +@end itemize + +@node sys-apropos, tabbar, silly-mail, Top +@chapter sys-apropos - Interface for the *nix apropos command. + +@noindent Author: Henrik Enberg + +@noindent Commands: + +@table @samp +@item sys-apropos +Ask the system apropos command for man-pages matching QUERY. +@end table + +Do @command{M-x sys-apropos} and you're off. In the *System Apropos* +buffer, @key{RET} shows the manual page for the program on that line and +@key{q} or @key{C-c C-c} quits the whole shebang. + +@node tabbar, tail, sys-apropos, Top +@chapter tabbar - Display a tab bar in the header line + +@noindent Author: David Ponce + +This library provides the Tabbar global minor mode to display a tab +bar in the header line of Emacs 21 and later versions. You can use +the mouse to click on a tab and select it. Also, three buttons are +displayed on the left side of the tab bar in this order: the +"home", "scroll left", and "scroll right" buttons. The "home" +button is a general purpose button used to change something on the +tab bar. The scroll left and scroll right buttons are used to +scroll tabs horizontally. Tabs can be divided up into groups to +maintain several sets of tabs at the same time (see also the +chapter "Core" below for more details on tab grouping). Only one +group is displayed on the tab bar, and the "home" button, for +example, can be used to navigate through the different groups, to +show different tab bars. + +In a graphic environment, using the mouse is probably the preferred +way to work with the tab bar. However, you can also use the tab +bar when Emacs is running on a terminal, so it is possible to use +commands to press special buttons, or to navigate cyclically +through tabs. + +These commands, and default keyboard shortcuts, are provided: + +@command{tabbar-mode} Toggle the Tabbar global minor mode. When +enabled a tab bar is displayed in the header line. + +@command{tabbar-local-mode} @key{C-c C-f10} Toggle the Tabbar-Local +minor mode. Provided the global minor mode is turned on, the tab bar +becomes local in the current buffer when the local minor mode is +enabled. This permits to see the tab bar in a buffer where the header +line is already used by another mode (like `Info-mode' for example). + +@command{tabbar-mwheel-mode} Toggle the Tabbar-Mwheel global minor +mode. When enabled you can use the mouse wheel to navigate through +tabs of groups. + +@command{tabbar-press-home} @key{C-c C-home} + +@command{tabbar-press-scroll-left} @key{C-c C-prior} + +@command{tabbar-press-scroll-right} @key{C-c C-next} Simulate a +mouse-1 click on respectively the "home", "scroll left", and "scroll +right" buttons. A numeric prefix argument value of 2, or 3, +respectively simulates a mouse-2, or mouse-3 click. + +@command{tabbar-backward} @key{C-c C-left} + +@command{tabbar-forward} @key{C-c C-right} are the basic commands to +navigate cyclically through tabs or groups of tabs. The cycle is +controlled by the `tabbar-cycle-scope' option. The default is to +navigate through all tabs across all existing groups of tabs. You can +change the default behavior to navigate only through the tabs visible +on the tab bar, or through groups of tabs only. Or use the more +specialized commands below. + +@command{tabbar-backward-tab} @command{tabbar-forward-tab} Navigate +through the tabs visible on the tab bar. + +@command{tabbar-backward-group} @key{C-c C-up} + +@command{tabbar-forward-group} @key{C-c C-down} + Navigate through existing groups of tabs. + +@node tail, tc, tabbar, Top +@chapter tail - Tail files within Emacs + +@noindent Author: Benjamin Drieu + +This program displays @emph{tailed} contents of files inside transients +windows of Emacs. It is primarily meant to keep an eye on logs within +Emacs instead of using additional terminals. + +@noindent Commands: + +@table @samp +@item tail-file +Tails FILE specified with argument FILE inside a new buffer. +@item tail-command +Tails COMMAND with arguments ARGS inside a new buffer. +@end table + +@node tc, tlc, tail, Top +@chapter tc - trivial-cite -- cite text with proper filling in mail + +@noindent Author: Lars R. Clausen + +Trivial-Cite has the same purpose as Supercite: Cite text for mail and +posting, but with different objectives. Trivial-Cite tries hard to do +the following correctly: + +@enumerate +@item + Fill paragraphs of previously cited text correctly, even when encountering strange citing marks. +@item + Parse the cited headers to allow attribution in a configurable way. +@item + Allow the user to undo formatting. +@item + Remove the signature as the last undoable action. +@item + Allow the user to cite and fill cited text in other contexts. +@item + Fix odd-looking citemarks to look nice (optional with @code{tc-normalize-cite-marks}). +@end enumerate + +Furthermore, it follows the suggestions of Son-of-RFC1036 and cites +with a >, and sensibly so. + +No, I will not make it quote with name abbreviations like SuperCite does. +That style is annoying and unreadable, goes against the RFC's (or rather, +the sons of them:), and have generally been the most problematic thing to +deal with. Trivial-cite can handle them, but is better at 'normal' +citation marking. + +@noindent To use, add the following to your .emacs: + +@verbatim +;; For Gnus: +(setq message-cite-function 'trivial-cite) + +;; For MH-E +(add-hook 'mail-citation-hook 'trivial-cite) +(setq mh-yank-from-start-of-msg t) +;; -> then use `C-cC-y' in your draft. +@end verbatim + +@node tlc, thinks, tc, Top +@chapter tlc - Major mode for editing tlc files + +@noindent Author: Eric M. Ludlam + +This is a major mode for editing Target Language Compiler scripts. It +automatically indents the programming constructs. + +@node thinks, tld, tlc, Top +@chapter thinks - Insert text in a think bubble. + +@noindent Author Dave Pearson + +thinks.el is a little bit of silliness inspired by the think bubbles you +see in cartoons. It allows you to + +@verbatim +. o O ( insert text that looks like this ) +@end verbatim + +into a buffer. This could possibly be handy for use in email and usenet +postings. + +@noindent The commands are: + +@table @samp +@item thinks +Insert TEXT wrapped in a think bubble. +@item thinks-region +Bubble wrap region bounding START and END. +@item thinks-yank +Do a `yank' and bubble wrap the yanked text. +@item thinks-maybe-region +If region is active, bubble wrap region bounding START and END. +@end table + +@noindent Note that the code can handle multiple lines + +@verbatim +. o O ( like this. That is, a body of text where the number of characters ) + ( exceeds the bounds of what you might consider to be a acceptable ) + ( line length (he says, waffling on to fill a couple of lines). ) +@end verbatim + +@noindent You can also control how the bubble looks with +@code{thinks-from}. The above had it set to @code{top}. You can have +@code{middle}: + +@verbatim + ( like this. That is, a body of text where the number of characters ) +. o O ( exceeds the bounds of what you might consider to be a acceptable ) + ( line length (he says, waffling on to fill a couple of lines). ) +@end verbatim + +@noindent @code{bottom}: + +@verbatim + ( like this. That is, a body of text where the number of characters ) + ( exceeds the bounds of what you might consider to be a acceptable ) +. o O ( line length (he says, waffling on to fill a couple of lines). ) +@end verbatim + +@noindent and @code{bottom-diagonal}: + +@verbatim + ( like this. That is, a body of text where the number of characters ) + ( exceeds the bounds of what you might consider to be a acceptable ) + ( line length (he says, waffling on to fill a couple of lines). ) + O + o +. +@end verbatim + +By default all of the thinking functions will fill (word wrap) the text +taking into account the value of @code{fill-column} minus the space required +for the bubble. Prefix a call to any of the functions with @key{C-u} to turn +off this behaviour. + +@node tld, todoo, thinks, Top +@chapter tld - TLD (Top Level Domain) lookup tool. + +@noindent Author: Dave Pearson + +tld.el provides a command for looking up TLDs (Top Level Domain), +either by searching for a specific TLD or by searching country +names. + +@noindent One command is provided: + +@table @samp +@item tld +Search the TLD list. +@end table + +@node todoo, toggle-option, tld, Top +@chapter todoo - Major mode for editing TODO files + +@noindent Author: Daniel Lundin + +@noindent todoo does not work under XEmacs. + +todoo.el is a mode for editing @emph{TODO} files in an outline-mode fashion. +It has similarities to Oliver Seidel's todo-mode.el , but todoo.el +has been significantly simplified to better adhere to mine and +other users' needs at the time. + +@noindent To show your personal todo-list: +@example +@command{M-x todoo} +@end example + +@noindent To be prompted a filename, supply any prefix to 'todoo': +@example +@command{C-u M-x todoo} +@end example + +@noindent For information on keybindings: +@example +@command{C-h f todoo-mode RET} +@end example + +Customize your todoo with: +@example +@command{M-x customize-group RET todoo RET} +@end example + +@node toggle-option, twiddle, todoo, Top +@chapter toggle-option - Easily toggle frequently toggled options + +@noindent Author: Cyprian Laskowski + +I find myself toggling the same Emacs features very often, and I +always set up key bindings for these features. The problem is that +the list is getting rather big, and it's a nuisance to sacrifice +individual bindings to such a simple operation as the toggling of a +variable. So the idea here is: set up a customizable list of +options and how they are to be toggled (whether the buffer-local or +global value is toggled, or whether a function is called), and +assign ONE command (@command{toggle-option}) to @emph{ONE} key, from which all +those options can be easily toggled (using completion). For +individual variables, you can set values to toggle to override the +default of nil and t. + +To enable it, customize the group @code{toggle-option} and then the +variable @code{toggle-option-list}. +See the documentation for @code{toggle-option-list} for details. + +I also highly recommend that you bind @command{toggle-option} to a +key, by putting something like the following in your .emacs file as +well: + +@example +(global-set-key "\M-o" 'toggle-option) +@end example + +Now you can toggle options by typing @key{M-o} (remember that +completion can be used on your list) and supplying the first few +characters of an option. + +@node twiddle, under, toggle-option, Top +@chapter twiddle - Cute mode-line display hack. + +@noindent Author: Noah Friedman + +Inspired by a similar hack by Jim Blandy . + +There are two user commands of interest: @command{twiddle-start} and +@command{twiddle-compile}: + +@table @samp +@item twiddle-start +Start a mode line display hack. +If called interactively with a prefix argument, prompt for the name of +a hack to run. +@item twiddle-compile +Like \\[compile], but run a twiddle hack during compilation. +@end table + +If you write new twiddles, try to minimize or avoid consing, since those +functions are called constantly. + +@node under, upstart-mode, twiddle, Top +@chapter under - Underline with the ^ character + +@noindent Author: Benjamin Drieu + +This provide the command @command{underhat-region} to underline part +of a line with the @code{^} character. + +Suggested key-binding to put in ~/.emacs: +@example + (global-set-key "\C-c\C-u" 'underhat-region) +@end example + +@emph{Bugs:} currently only works on a single line. The region can't +span multiple lines. + +@node upstart-mode, xrdb-mode, under, Top +@chapter upstart-mode - Mode for editing upstart files + +@noindent Author: Stig Sandbeck Mathisen + +A major mode for .upstart files. Upstart is an event-based replacement +for the traditional init daemon. + +You may optionally add @code{MMM-mode} for highlighting the embedded +shell scripts inside the script blocks (Note: indentation does not work +inside the mmm blocks. Any assistance would be welcome). Add the +following to your @file{.emacs} file if you wish to do so: + +@example + (require 'mmm-auto) + (setq mmm-global-mode 'maybe) + (mmm-add-classes + '((upstart-sh + :submode sh-mode + :face mmm-submode-decoration-level "code" + :front "^\\(\\(pre\\|post\\)-\\(start\\|stop\\) \\)?script" + :front-offset (end-of-line 1) + :back "end script" + :end-not-begin t))) + (mmm-add-mode-ext-class 'upstart-mode nil 'upstart-sh) +@end example + +@node xrdb-mode, , upstart-mode, Top +@chapter xrdb-mode - Mode for editing X resource database files + +@noindent Author: Barry A. Warsaw + +This file provides a major mode for editing X resource database files +(e.g. .Xdefaults, .Xenvironment, .Xresources). It includes font-lock +definitions and commands for controlling indentation, re-indenting by +subdivisions, and loading and merging into the the resource database. + +The mode should load automatically for appropriate files after having +customized @code{xrdb-mode-setup-auto-mode-alist}, or invoke it +using @command{xrdb-mode}. diff --git a/elisp/emacs-goodies-el/emacs-goodies-loaddefs.make b/elisp/emacs-goodies-el/emacs-goodies-loaddefs.make new file mode 100755 index 0000000..1d49eb2 --- /dev/null +++ b/elisp/emacs-goodies-el/emacs-goodies-loaddefs.make @@ -0,0 +1 @@ + emacs -batch --no-site-file --multibyte --eval '(setq load-path (cons "." load-path))' -l autoload --eval '(setq generated-autoload-file (expand-file-name "emacs-goodies-loaddefs.el"))' --eval '(setq make-backup-files nil)' -f batch-update-autoloads . diff --git a/elisp/emacs-goodies-el/eproject-extras.el b/elisp/emacs-goodies-el/eproject-extras.el new file mode 100644 index 0000000..6177517 --- /dev/null +++ b/elisp/emacs-goodies-el/eproject-extras.el @@ -0,0 +1,308 @@ +;;; eproject-extras.el --- various utilities that make eproject more enjoyable + +;; Copyright (C) 2009 Jonathan Rockway + +;; Author: Jonathan Rockway +;; Keywords: eproject + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; Some of this stuff used to be in eproject "core", but it is a bit +;; bloated, and not strictly necessary. So now it lives here, leaving +;; the eproject core pristine and minimal. + +;;; Code: + +(require 'eproject) +(require 'cl) +(require 'iswitchb) +(require 'ibuffer) +(require 'ibuf-ext) + +;; support for visiting other project files +(defalias 'eproject-ifind-file 'eproject-find-file) ;; ifind is deperecated + +(defun eproject--shorten-filename (filename) + "Shorten FILENAME in the context of the current project. +Uses the function provided by the `:file-name-map' project attribute. + +The default implementation just makes the filename relative to +the project root." + (cons (funcall (eproject-attribute :file-name-map) + (eproject-root) + (file-relative-name filename (eproject-root))) + filename)) + +;;;###autoload +(defun eproject-find-file () + "Present the user with a list of files in the current project. +to select from, open file when selected." + (interactive) + (find-file (eproject--icomplete-read-with-alist + "Project file: " + (mapcar #'eproject--shorten-filename (eproject-list-project-files))))) + +(defun eproject--completing-read (prompt choices) + "Use completing-read to do a completing read." + (completing-read prompt choices nil t)) + +(defun eproject--icompleting-read (prompt choices) + "Use iswitchb to do a completing read." + (let ((iswitchb-make-buflist-hook + (lambda () + (setq iswitchb-temp-buflist choices)))) + (unwind-protect + (progn + (when (not iswitchb-mode) + (add-hook 'minibuffer-setup-hook 'iswitchb-minibuffer-setup)) + (iswitchb-read-buffer prompt nil t)) + (when (not iswitchb-mode) + (remove-hook 'minibuffer-setup-hook 'iswitchb-minibuffer-setup))))) + +(defun eproject--ido-completing-read (prompt choices) + "Use ido to do a completing read." + (ido-completing-read prompt choices nil t)) + +(defcustom eproject-completing-read-function + #'eproject--icompleting-read + "Ask the user select a single file from a list of files. +Used by `eproject-find-file'." + :group 'eproject + :type '(radio (function-item :doc "Use emacs' standard completing-read function." + eproject--completing-read) + (function-item :doc "Use iswitchb's completing-read function." + eproject--icompleting-read) + (function-item :doc "Use ido's completing-read function." + eproject--ido-completing-read) + (function))) + +(defun eproject--do-completing-read (&rest args) + "Do a completing read with the user's favorite completing read function." + (apply eproject-completing-read-function args)) + +(defun eproject--icomplete-read-with-alist (prompt alist) + (let ((show (mapcar (lambda (x) (car x)) alist))) + (cdr (assoc (eproject--do-completing-read prompt show) alist)))) + +(defun eproject--project-buffers () + "Return an alist mapping each project root to its open buffers. + +Does not list the project if it doesn't have any buffers." + (let ((hash (make-hash-table :test 'equal))) + (loop for x in + (mapcar (lambda (b) (ignore-errors (cons (eproject-root b) b))) + (buffer-list)) + when (not (null x)) + do (puthash (car x) + (cons (cdr x) (gethash (car x) hash)) hash)) + (loop for key being the hash-keys of hash + collect (cons key (gethash key hash))))) + +(defun* eproject--get-name-root-alist (&key live-only) + (let ((all-projects (eproject-projects)) + (buffers (eproject--project-buffers))) + + (when (null all-projects) + (error "No projects yet")) + + (if live-only + (remove-if #'null (mapcar (lambda (x) (rassoc (car x) all-projects)) buffers)) + all-projects))) + +(defun* eproject--read-project-name (&key live-only) + (eproject--icomplete-read-with-alist + "Project name: " (eproject--get-name-root-alist :live-only live-only))) + +(defun* eproject--handle-root-prefix-arg (prefix &key live-only) + (if (= prefix 4) + (eproject--read-project-name :live-only live-only) + (eproject-root))) + +;; ibuffer support + +(define-ibuffer-filter eproject-root + "Filter buffers that have the provided eproject root" + (:reader (read-directory-name "Project root: " (ignore-errors (eproject-root))) + :description "project root") + (with-current-buffer buf + (equal (file-name-as-directory (expand-file-name qualifier)) + (ignore-errors (eproject-root))))) + +(define-ibuffer-filter eproject + "Filter buffers that have the provided eproject name" + (:reader (eproject--do-completing-read "Project name: " (eproject-project-names)) + :description "project name") + (with-current-buffer buf + (equal qualifier + (ignore-errors (eproject-name))))) + +(define-ibuffer-column eproject (:name "Project" :inline t) + (ignore-errors (eproject-name))) + +;;;###autoload +(defun eproject-ibuffer (prefix) + "Open an IBuffer window showing all buffers in the current project, or named project if PREFIX arg is supplied." + (interactive "p") + (if (= prefix 4) + (call-interactively #'eproject--ibuffer-byname) + (ibuffer nil "*Project Buffers*" + (list (cons 'eproject-root (eproject-root)))))) + +(defun eproject--ibuffer-byname (project-name) + "Open an IBuffer window showing all buffers in the project named PROJECT-NAME." + (interactive (list + (eproject--do-completing-read + "Project name: " (eproject-project-names)))) + (ibuffer nil (format "*%s Buffers*" project-name) + (list (cons 'eproject project-name)))) + +;; extra macros + +(defmacro* with-each-buffer-in-project + ((binding &optional project-root) + &body body) + "Given a project root PROJECT-ROOT, finds each buffer visiting a file in that project, and executes BODY with each buffer bound to BINDING (and made current)." + (declare (indent 2)) + `(progn + (loop for ,binding in (cdr (assoc (or ,project-root (eproject-root)) + (eproject--project-buffers))) + do + (with-current-buffer ,binding + ,@body)))) + +;; bulk management utils +;;;###autoload +(defun eproject-kill-project-buffers (prefix) + "Kill every buffer in the current project, including the current buffer. + +If PREFIX is specified, prompt for a project name and kill those +buffers instead." + (interactive "p") + (with-each-buffer-in-project + (buf (eproject--handle-root-prefix-arg prefix :live-only t)) + (kill-buffer buf))) + +(defun eproject-open-all-project-files (prefix) + "Open every file in the same project. + +If PREFIX arg is supplied, prompt for a project. Otherwise, +assume the project of the current buffer." + (interactive "p") + (let ((total 0) + (root (eproject--handle-root-prefix-arg prefix))) + (message "Opening files...") + (save-window-excursion + (loop for file in (eproject-list-project-files root) + do (progn (find-file file) (incf total)))) + (message "Opened %d files" total))) + +;; project management + +(defun eproject-project-root (project) + "Given a PROJECT name, return the root directory." + (let ((projects (eproject--get-name-root-alist))) + (cdr (assoc project projects)))) + +;;;###autoload +(defun eproject-revisit-project (prefix) + "Given a project name, visit the root directory. + +If PREFIX arg is supplied, run `eproject-find-file'." + (interactive "p") + (let ((eproject-root (eproject--read-project-name)) + (eproject-mode t)) ;; XXX: very messy, needs rewrite + (if (= prefix 4) + (eproject-find-file) + (find-file eproject-root)))) + +;; grep project files (contributed by Julian Snitow) + +;; TODO: make the grep command customizable; to use "Ack", for example +;;;###autoload +(defun eproject-grep (regexp) + "Search all files in the current project for REGEXP." + (interactive "sRegexp grep: ") + (let* ((root (eproject-root)) + (default-directory root) + (files (eproject-list-project-files-relative root))) + (grep-compute-defaults) + (lgrep regexp (combine-and-quote-strings files) root))) + +(defcustom eproject-todo-expressions + '("TODO" "XXX" "FIXME") + "A list of tags for `eproject-todo' to search for when generating the project's TODO list." + :group 'eproject + :type '(repeat string)) + +;;;###autoload +(defun eproject-todo () + "Display a project TODO list. + +Customize `eproject-todo-expressions' to control what this function looks for." + (interactive) + ;; TODO: display output in a buffer called *-TODO* instead of *grep*. + (eproject-grep (regexp-opt eproject-todo-expressions))) + +;;;###autoload +(defun eproject-multi-isearch-buffers () + "Do a `multi-isearch' on opened buffers in the current project. + +Run `eproject-open-all-project-files' first or just +`eproject-grep' if you want to search all project files." + (interactive) + (multi-isearch-buffers + (cdr (assoc (eproject-root) (eproject--project-buffers))))) + +;;;###autoload +(defun eproject-eshell-cd-here (&optional look-in-invisible-buffers) + "If there is an EShell buffer, cd to the project root in that buffer. + +With the prefix arg LOOK-IN-INVISIBLE-BUFFERS looks in buffers that are not currently displayed." + (interactive "p") + (setq look-in-invisible-buffers (cond ((= look-in-invisible-buffers 4) t))) + (let* ((root (eproject-root)) + (eshell-p (lambda (buf) + (with-current-buffer buf (eq major-mode 'eshell-mode)))) + (eshell-buffer (find-if eshell-p + (if look-in-invisible-buffers + (buffer-list) + (mapcar (lambda (w) (window-buffer w)) + (window-list)))))) + + (cond ((and (not eshell-buffer) look-in-invisible-buffers) + (error "No EShell buffer!")) + ((and (not eshell-buffer) (not look-in-invisible-buffers)) + (error "No visible EShell buffer; try re-running with the prefix arg")) + (eshell-buffer + (with-current-buffer eshell-buffer + (goto-char (point-max)) + (eshell/cd root) + (eshell-send-input nil t) + eshell-buffer))))) ;; returns eshell-buf so you can focus + ;; the window if you want + +;;;###autoload +(defun eproject-compile () + "Run `compile-command' in the project root." + (interactive) + (let ((default-directory (eproject-root))) + (call-interactively #'compile))) + +(define-key eproject-mode-map (kbd "C-c C-f") #'eproject-find-file) +(define-key eproject-mode-map (kbd "C-c C-b") #'eproject-ibuffer) + +(provide 'eproject-extras) +;;; eproject-extras.el ends here diff --git a/elisp/emacs-goodies-el/eproject.el b/elisp/emacs-goodies-el/eproject.el new file mode 100644 index 0000000..ca680b9 --- /dev/null +++ b/elisp/emacs-goodies-el/eproject.el @@ -0,0 +1,679 @@ +;;; eproject.el --- assign files to projects, programatically +;; +;; Copyright (C) 2008, 2009 Jonathan Rockway +;; +;; Author: Jonathan Rockway +;; Maintainer: Jonathan Rockway +;; Created: 20 Nov 2008 +;; Version: 1.5 +;; Keywords: programming, projects +;; +;; This file is not a part of GNU Emacs. +;; +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation; either version 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: +;; +;; Eproject is an extension that lets you group related files together +;; as projects. It aims to be as unobtrusive as possible -- no new +;; files are created (or required to exist) on disk, and buffers that +;; aren't a member of a project are not affected in any way. +;; +;; The main starting point for eproject is defining project types. +;; There is a macro for this, define-project-type, that accepts four +;; arguments, the type name (a symbol), a list of supertypes (for +;; inheriting properties), a form that is executed to determine +;; whether a file is a member of a project, and then a free-form +;; property list. An example will clear things up. +;; +;; Let's create a "perl" project type, for Perl projects that have a +;; Makefile.PL. +;; +;; (define-project-type perl (generic) +;; (look-for "Makefile.PL") +;; :relevant-files ("\\.pm$" "\\.t$")) +;; +;; Now when you open a file and somewhere above in the directory tree +;; there is a Makefile.PL, it will be a "perl project". +;; +;; There are a few things you get with this. A hook called +;; perl-project-file-visit-hook will be run, and the buffer will have +;; the "eproject-mode" minor-mode turned on. You can also read and +;; set metadata via the eproject-attribute and +;; eproject-add-project-metadatum calls. +;; +;; (This is mostly helpful to Lisp programmers rather than end-users; +;; if you want tools for visiting and managing projects (and ibuffer +;; integration), load `eproject-extras'. These extras are great +;; examples of the eproject API in action, so please take a look even +;; if you don't want those exact features.) +;; +;; Let's look at the mechanics of the define-project-type call. The +;; first argument is the name of the project type -- it can be any +;; symbol. The next argument is a list of other projects types that +;; this project will inherit from. That means that if you call +;; eproject-get-project-metadatum and the current project doesn't +;; define a value, we'll look at the supertypes until we get something +;; non-nil. Usually you will want to set this to (generic), which +;; will make your type work correctly even if you don't define any of +;; your own metadata. +;; +;; The next argument is a form that will be executed with the filename +;; that was just opened bound to FILE. It is expected to return the +;; project root, or nil if FILE is not in a project of this type. The +;; look-for function will look up the directory tree for a file that +;; is named the same as its argument (see the docstring for +;; `eproject--look-for-impl' for all the details). You can write any +;; Lisp here you like; we'll see some more examples later. (You only +;; get one form, so if you need to execute more than one, just wrap it +;; in a progn.) +;; +;; The final (&rest-style) argument is a property list of initial project +;; metadata. You can put anything you want here, as long as it is in the +;; form of a property list (keyword, value, keyword, value, ...). +;; +;; After this form runs, eproject will be able to recognize files in +;; the type of the project you defined. It also creates a hook named +;; -project-file-visit-hook. You can do anything you want here, +;; including access (eproject-type) and (eproject-root). +;; +;; As an example, in my perl-project-file-visit-hook, I do this: +;; +;; (lambda () +;; (ignore-errors +;; (stylish-repl-eval-perl +;; (format "use lib '%s'" (car (perl-project-includes))))))) +;; +;; This will add the library directory of this project to my current +;; stylish-repl session, so that I can use my project in the REPL +;; immediately. (I do something similar for Lisp + SLIME projects) +;; +;; That's basically all there is. eproject is designed to be minimal and +;; extensible, so I hope it meets your needs. +;; +;; Please e-mail me or find me on #emacs (jrockway) if you have +;; questions. If you'd like to send a patch (always appreciated), +;; please diff against the latest git version, available by running: +;; +;; $ git clone git://github.com/jrockway/eproject +;; +;; Share and enjoy. + +;;; Public API: + +;; eproject-root (&optional buffer) +;; +;; - returns the project root for the project that buffer is a member +;; of. defaults to the current buffer + +;; eproject-attribute (key &optional root) +;; +;; - returns the value of key for the project that buffer is a member +;; of. root defaults to the current buffer's eproject-root + +;; eproject-list-project-files + +;; define-project-type + +;; define-project-attribute + +;; eproject-projects + +;; Everything else is mostly used internally, and may change. + +;;; Public commands: + +;; eproject-maybe-turn-on +;; +;; - turn on eproject for the current buffer, if possible +;; (if it's turned on, the hooks will be run) + +;; eproject-reinitialize-project +;; +;; - re-read config for the current project, then run +;; eproject-maybe-turn-on +;; +;; this is bound to C-c C-c when editing .eproject files, which is +;; very convenient for testing. + +;; See eproject-extras.el for more interesting / useful commands. +;; This file is mostly "plumbing". + +;;; Bugs: +;; +;; You can't forward reference supertypes -- this will mess things up +;; internally, but you won't get a warning. This can be easily fixed +;; by using a smarter algorithm for eproject--all-types. +;; +;; The "linearized isa" (i.e. "class precedence list") is computed +;; with a depth-first search. This is bad; we should really use the +;; C3 ordering. + +;;; Website: +;; +;; The latest version is on github at +;; http://github.com/jrockway/eproject/tree/master +;; +;; The wiki has lots more documentation: +;; http://wiki.github.com/jrockway/eproject +;; + +;;; The Changelog section documents major changes. Minor non-breaking +;;; updates are regularly committed to git. + +;;; Changelog: +;; +;; 1.6 (Sat Aug 28 22:21:39 CDT 2010) +;; +;; * Remove eproject-project-names variable and add some proper +;; introspection for project sets. +;; +;; 1.5 (Thu May 28 21:38:08 MST 2009) +;; +;; * Split out the non-core stuff into eproject-extras.el. +;; (slime-contrib style) +;; +;; 1.4 (Thu May 28 02:21:40 MST 2009) +;; +;; * Add support for "instance" metadata, instead of "class" (project) +;; metadata +;; +;; 1.3 (Wed May 27 20:47:48 MST 2009) +;; +;; * Officially support w32 +;; +;; 1.2 (Thu May 7 02:18:01 CDT 2009) +;; +;; * Add ibuffer support +;; +;; 1.1 (Sat Jan 31 20:03:56 CST 2009) +;; +;; * Make the completing-read function customizable +;; +;; 1.0 (Nov 28 2008) +;; +;; * Initial release +;; + +;;; Code: + +(require 'cl) +(require 'eshell) ;; For portable path handling + +(defgroup eproject nil + "Eproject; provide support for grouping files and buffers into projects" + :prefix "eproject-" + :group 'convenience + :link '(emacs-commentary-link :tag "Commentary" "eproject.el") + :link '(emacs-library-link :tag "Optional extras" "eproject-extras.el") + :link '(url-link :tag "Github wiki" "http://wiki.github.com/jrockway/eproject")) + +(defvar eproject-root nil + "A buffer-local variable set to the root of its eproject + project. NIL if it isn't in an eproject. Your code should + call the function `eproject-root` instead of accessing this + variable directly. It should also not set it; only + `eproject-maybe-turn-on' can do that.") + +(make-variable-buffer-local 'eproject-root) + +(defvar eproject-project-types nil + "An alist of project type name to (supertypes selector metadata-plist) pairs.") + +(defvar eproject-extra-attributes nil + "A list of pairs used to assign attributes to projects. + +Each entry can be in the form of `(FUNCTION (ATTRIBUTES))' +or `((KEY . TYPE) (ATTRIBUTES))'. + +If FUNCTION is specified, it will be evaluated for each project +root. If it returns a non-nil value, ATTRIBUTES will be added to +the project attributes. + +If `(KEY . TYPE)' is specified, then TYPE is either +`:root-regexp' or `:project-name' and KEY is interpreted +accordingly. If KEY matches a project root, its ATTRIBUTES are +applied. + +ATTRIBUTES is a plist of attributes.") + +(defvar eproject-attributes-alist nil + "An alist of project root -> plist of project metadata.") + +(defvar eproject-first-buffer-hook nil + "Hook to run when the first buffer in a new project is opened. + Called after the project is initialized, so it's safe to call + eproject functions.") + +(defvar eproject-projects-hook nil + "Hook that's run when a list of projects is requested. Hook may return a list of new (name . root) pairs to be added to eproject's internal list.") + +(defvar eproject-project-change-hook nil + "Hook that's run when a project is changed; currently this means when a file in the project is saved.") + +(defun define-project-attribute (key attributes) + "Define extra attributes to be applied to projects. + +See `eproject-extra-attributes' for details on the format of KEY +and ATTRIBUTES." + (check-type key (or function cons)) + (check-type attributes list) + (add-to-list 'eproject-extra-attributes (list key attributes))) + +(defmacro define-project-type (type supertypes selector &rest metadata) + "Define a new project type TYPE that inherits from SUPERTYPES. + +SELECTOR is a form that is given a filename FILE and returns the +project root if it is of this type of project, or NIL otherwise. + +Optional argument METADATA is a plist of metadata that will +become project attributes." + `(progn + (defvar ,(intern (format "%s-project-file-visit-hook" type)) nil + ,(format "Hooks that will be run when a file in a %s project is opened." type)) + (setq eproject-project-types + (nconc (assq-delete-all ',type eproject-project-types) + (list + (list ',type ',supertypes + (lambda (file) ,selector) + ',metadata)))))) + +(defun eproject--build-parent-candidates (start-at) + "Given directory START-AT, return a list of parent directories, including START-AT." + (loop for x on (reverse (eshell-split-path start-at)) by #'cdr + ;; i think eshell-split-path guarantees the + ;; file-name-as-directory application, but i don't want to + ;; debug it if it doesn't :) + collect (file-name-as-directory (apply #'concat (reverse x))))) + +(defun eproject--scan-parents-for (start-at predicate) + "Call PREDICATE with each parent directory of START-AT, returning the path to the first directory where PREDICATE returns T." + (find-if predicate (eproject--build-parent-candidates + (file-name-as-directory start-at)))) + +(defun eproject--find-file-named (start-at filename) + "Starting in directory START-AT, recursively check parent directories for a file named FILENAME. Return the directory where the file is first found; return NIL otherwise." + (eproject--scan-parents-for start-at + (lambda (directory) ; note that directory always has the path separator on the end + (file-exists-p (concat directory filename))))) + +;; TODO: sugar around lambda/lambda, which is ugly +(define-project-type generic () nil + :relevant-files (".*") + :irrelevant-files ("^[.]" "^[#]") + :file-name-map (lambda (root) (lambda (root file) file)) + :local-variables (lambda (root) (lambda (root file) nil)) + :config-file ".eproject") + +(define-project-type generic-eproject (generic) (look-for ".eproject")) + +(define-project-type generic-git (generic) (look-for ".git") + :irrelevant-files ("^[.]" "^[#]" ".git/")) + +(defun eproject--type-info (type) + (or + (assoc type eproject-project-types) + (error "No type %s" type))) + +(defun eproject--project-supertypes (type) + (nth 1 (eproject--type-info type))) + +(defun eproject--project-selector (type) + (nth 2 (eproject--type-info type))) + +(defun* eproject--look-for-impl (file expression &optional (type :filename)) + "Implements the LOOK-FOR function that is flet-bound during +`eproject--run-project-selector'. EXPRESSION and TYPE specify +what to look for. Some examples: + + (look-for \"Makefile.PL\") ; look up the directory tree for a file called Makefile.PL + (look-for \"*.PL\" :glob) ; look for a file matching *.PL +" + (case type + (:filename (eproject--find-file-named file expression)) + (:glob (eproject--scan-parents-for (file-name-directory file) + (lambda (current-directory) + (let ((default-directory current-directory)) + (and (not (equal file current-directory)) + (> (length (file-expand-wildcards expression)) 0)))))) + (otherwise (error "Don't know how to handle %s in LOOK-FOR!" type)))) + +(defun eproject--buffer-file-name () + (or (buffer-file-name) (and (eq major-mode 'dired-mode) + (expand-file-name (if (consp dired-directory) + (car dired-directory) + dired-directory))))) + +(defun* eproject--run-project-selector (type &optional (file (eproject--buffer-file-name))) + "Run the selector associated with project type TYPE." + (when (not file) + (error "Buffer '%s' has no file name" (current-buffer))) + (flet ((look-for (expr &optional (expr-type :filename)) + (funcall #'eproject--look-for-impl file expr expr-type))) + (funcall (eproject--project-selector type) file))) + +(defun eproject--linearized-isa (type &optional include-self) + (delete-duplicates + (nconc + (if include-self (list type)) + (eproject--project-supertypes type) + (loop for stype in (eproject--project-supertypes type) + nconc (eproject--linearized-isa stype))))) + +(defun eproject--all-types () + ;; this should be most specific to least specific, as long as nothing + ;; is forward-referenced. + (reverse (mapcar #'car eproject-project-types))) + +;; metadata vs. attributes: +;; * metadata is per-project-type +;; * attributes are per-project-root (and includes the project-type metadata) +(defun eproject--compute-all-applicable-metadata (type) + (loop for next-type in (eproject--linearized-isa type t) + append (nth 3 (eproject--type-info next-type)))) + +(defun eproject-get-project-metadatum (type key) + (getf (eproject--compute-all-applicable-metadata type) key)) + +(defun eproject-add-project-metadatum (type key value) + (setf (getf (nth 3 (assoc type eproject-project-types)) key) value)) + +(defmacro* eproject--do-in-buffer ((buffer) &body forms) + `(with-current-buffer ,buffer + (when (not eproject-mode) + (error "Buffer is not an eproject buffer!")) + ,@forms)) + +(defun* eproject-root (&optional (buffer (current-buffer))) + "Return the value of the eproject variable root. +BUFFER defaults to the current buffer" + (eproject--do-in-buffer (buffer) eproject-root)) + +(defun* eproject-attribute (key &optional (root (eproject-root))) + "Lookup the attribute KEY for the eproject ROOT +ROOT defaults to the current buffer's project-root." + (getf (cdr (assoc root eproject-attributes-alist)) key)) + +(defun eproject--known-project-roots () + "Return a list of projects roots that have been visisted this session." + (loop for (key . value) in eproject-attributes-alist collect key)) + +(defmacro define-eproject-accessor (variable) + "Create a function named eproject-VARIABLE that return the value of VARIABLE in the context of the current project." + (let ((sym (intern (format "eproject-%s" variable)))) + `(defun* ,sym + (&optional (buffer (current-buffer))) + ,(format "Return the value of the eproject variable %s. BUFFER defaults to the current buffer." variable) + (eproject-attribute ,(intern (format ":%s" variable)))))) + +(define-eproject-accessor type) +(define-eproject-accessor name) + +(defun eproject-reinitialize-project () + "Forget all project settings for the current eproject, then reload them." + (interactive) + (let ((root (eproject-root))) + (setf eproject-attributes-alist + (delete-if (lambda (x) (equal (car x) root)) + eproject-attributes-alist))) + (eproject-maybe-turn-on) + (if (ignore-errors (eproject-root)) + (message "Project `%s' reinitialized successfully." (eproject-name)) + (message "Error reinitializing project!"))) + +(defun eproject--maybe-reinitialize () + "Run by `eproject-project-change-hook' to reinit the project after .eproject is modified." + (when (and (eq major-mode 'dot-eproject-mode) + (boundp 'eproject-root) eproject-root) + (eproject-reinitialize-project))) + +(defun eproject--eval-user-data (project-name root) + "Interpret EPROJECT-EXTRA-ATTRIBUTES for PROJECT-NAME (in ROOT)." + (loop for (key attributes) in eproject-extra-attributes append + (cond ((functionp key) + (if (funcall key root) attributes nil)) + ((not (listp key)) + (error "Bad eproject user data (%s %s), %s must be a list/function" + key attributes key)) + ((and (eq (cdr key) :project-name) + (equal (car key) project-name)) + attributes) + ((and (eq (cdr key) :root-regexp) + (string-match (car key) root)) + attributes) + (t nil)))) + +(defun eproject--interpret-metadata (data root) + "Interpret DATA with respect to ROOT. + +This mostly means evaluating functions and passing everything +else through unchanged." + (loop for i in data collect (if (functionp i) (funcall i root) i))) + +(defun eproject--init-attributes (root type) + "Update the EPROJECT-ATTRIBUTES-ALIST for the project rooted at ROOT (of TYPE)." + (let ((project-data (assoc root eproject-attributes-alist))) + (when (null project-data) + (let* ((class-data (eproject--interpret-metadata + (eproject--compute-all-applicable-metadata type) + root)) + + ;; read the .eproject (or whatever) file + (config-file + (concat root (getf class-data :config-file ".eproject"))) + (config-file-contents + (with-temp-buffer + (ignore-errors (insert-file-contents config-file nil nil nil t)) + (buffer-substring-no-properties (point-min) (point-max)))) + (config-file-sexp + (read (format "(list %s)" config-file-contents))) + (data-is-unsafe (unsafep config-file-sexp)) + (config-file-data + (cond (data-is-unsafe + (warn "Config file %s contains unsafe data (%s), ignoring!" + config-file data-is-unsafe) + nil) + (t (let ((data (eval config-file-sexp))) + (if data (nconc + (list :loaded-from-config-file config-file) + data) + nil))))) + + ;; combine class and config data; config overriding class + (class-and-config-data (cond + ;; ensure that the config-file-data is really a plist + ((evenp (length config-file-data)) + (nconc config-file-data class-data)) + (t class-data))) + + ;; calculate the project name, as it's used by "user + ;; data" + + ;; backcompat note: not sure why i looked in + ;; :project-name for the value to set the :name attribute + ;; to. so now we look in both, preferring the new way. + (name (or (getf class-and-config-data :name) + (getf class-and-config-data :project-name) + (directory-file-name + (elt (reverse (eshell-split-path root)) 0)))) + + ;; finally, merge in the "user data" + (user-data + (eproject--interpret-metadata + (eproject--eval-user-data name root) root)) + + ;; now compute the final list of attributes + (data (nconc user-data class-and-config-data))) + + (add-to-list 'eproject-attributes-alist + (cons root (nconc (list :type type :name name) data))))))) + +(defvar eproject-mode-map (make-sparse-keymap) + "Keybindings while in eproject-mode") + +(define-minor-mode eproject-mode + "A minor mode for buffers that are a member of an eproject project." + nil " Project" eproject-mode-map + (when (null eproject-root) + (error "Please do not use this directly. Call eproject-maybe-turn-on instead."))) + +(defun eproject-maybe-turn-on () + "Turn on eproject for the current buffer, if it is in a project." + (interactive) + (let (bestroot besttype (set-before (mapcar #'car eproject-attributes-alist))) + (loop for type in (eproject--all-types) + do (let ((root (eproject--run-project-selector type))) + (when (and root + (or (not bestroot) + ;; longest filename == best match (XXX: + ;; need to canonicalize?) + (> (length root) (length bestroot)))) + (setq bestroot root) + (setq besttype type)))) + (when bestroot + (setq eproject-root (file-name-as-directory bestroot)) + + ;; read .eproject file (etc.) and initialize at least :name and + ;; :type + (condition-case e + (eproject--init-attributes eproject-root besttype) + (error (display-warning 'warning + (format "There was a problem setting up the eproject attributes for this project: %s" e)))) + + ;; with :name and :type set, it's now safe to turn on eproject + (eproject-mode 1) + + ;; initialize buffer-local variables that the project defines + ;; (called after we turn on eproject-mode, so we can call + ;; eproject-* functions cleanly) + (condition-case e + (eproject--setup-local-variables) + (error (display-warning 'warning + (format "Problem initializing project-specific local-variables in %s: %s" + (eproject--buffer-file-name) e)))) + + ;; run the first-buffer hooks if this is the first time we've + ;; seen this particular project root. + (when (not (member eproject-root set-before)) + (run-hooks 'eproject-first-buffer-hook)) + + ;; run project-type hooks, which may also call into eproject-* + ;; functions + (run-hooks (intern (format "%s-project-file-visit-hook" besttype))) + + ;; return the project root; it's occasionally useful for the caller + bestroot))) + +(defun eproject--setup-local-variables () + "Setup local variables as specified by the project attribute :local-variables." + (let* ((var-maker (eproject-attribute :local-variables)) + (vars (cond ((functionp var-maker) + (funcall var-maker + (eproject-root) + (file-relative-name (eproject--buffer-file-name) + (eproject-root)))) + ((listp var-maker) var-maker)))) + (loop for (name val) on vars by #'cddr do + (set (make-local-variable name) val)))) + +(defun eproject--search-directory-tree (directory file-regexp ignore-regexp) + (loop for file in (directory-files (file-name-as-directory directory) t "^[^.]" t) + when (and (not (file-directory-p file)) + (not (string-match ignore-regexp file)) + (not (string-match ignore-regexp (file-name-nondirectory file))) + (string-match file-regexp file)) + collect file into files + when (file-directory-p file) + collect file into directories + finally return + (nconc files + (loop for dir in directories + nconc (eproject--search-directory-tree dir file-regexp + ignore-regexp))))) +(defun eproject-assert-type (type) + "Assert that the current buffer is in a project of type TYPE." + (when (not (memq type (eproject--linearized-isa (eproject-type) t))) + (error (format "%s is not in a project of type %s!" + (current-buffer) type)))) + +(defun eproject--combine-regexps (regexp-list) + "Combine regexps like `regexp-opt', but without quoting anything. +Argument REGEXP-LIST is a list of regexps to combine." + (format "\\(?:%s\\)" + (reduce (lambda (a b) (concat a "\\|" b)) + (mapcar (lambda (f) (format "\\(?:%s\\)" f)) regexp-list)))) + +(defun* eproject-list-project-files (&optional (root (eproject-root))) + "Return a list of all project files in PROJECT-ROOT." + (let ((matcher (eproject--combine-regexps + (eproject-attribute :relevant-files root))) + (ignore (eproject--combine-regexps (cons + (concat (regexp-opt completion-ignored-extensions t) "$") + (eproject-attribute :irrelevant-files root))))) + (eproject--search-directory-tree root matcher ignore))) + +(defun* eproject-list-project-files-relative (&optional (root (eproject-root))) + (mapcar (lambda (file) + (file-relative-name file root)) + (eproject-list-project-files root))) + +(define-derived-mode dot-eproject-mode emacs-lisp-mode "dot-eproject" + "Major mode for editing .eproject files." + (define-key dot-eproject-mode-map (kbd "C-c C-c") #'eproject-reinitialize-project)) + +;; introspect sets of projects +(defun eproject-projects () + "Return a list of (name . root) pairs of all known eproject projects." + (let ((hash (make-hash-table :test 'equal))) + (loop for f in eproject-projects-hook do + (loop for (name . root) in (funcall f) + do (puthash name root hash))) + (loop for (root . rest) + in eproject-attributes-alist + do (puthash (or (getf rest :name) (getf rest :project-name)) + root hash)) + (loop for name being each hash-key in hash + collect (cons name (gethash name hash))))) + +(defun eproject-project-names () + "Return a list of project names known to eproject." + (mapcar #'car (eproject-projects))) + +;; Finish up +(defun eproject--after-change-major-mode-hook () + (when (and (buffer-file-name) + (not eproject-root)) + (eproject-maybe-turn-on))) + +(defun eproject--after-save-hook () + ;; TODO: perhaps check against relevant-files or irrelevant-files + ;; regex? I'm avoiding this now because I'd rather not force the + ;; speed hit -- if the user wants to do something slow after save, + ;; fine... but I'd rather not make the decision for him. + (when (and (boundp 'eproject-root) eproject-root) + (run-hooks 'eproject-project-change-hook))) + +(add-hook 'find-file-hook #'eproject-maybe-turn-on) +(add-hook 'dired-mode-hook #'eproject-maybe-turn-on) +(add-hook 'after-change-major-mode-hook #'eproject--after-change-major-mode-hook) +(add-hook 'after-save-hook #'eproject--after-save-hook) + +(add-hook 'eproject-project-change-hook #'eproject--maybe-reinitialize) + +(add-to-list 'auto-mode-alist '("\\.eproject$" . dot-eproject-mode)) + +(provide 'eproject) +;;; eproject.el ends here diff --git a/elisp/emacs-goodies-el/ff-paths.el b/elisp/emacs-goodies-el/ff-paths.el new file mode 100755 index 0000000..ec18f7c --- /dev/null +++ b/elisp/emacs-goodies-el/ff-paths.el @@ -0,0 +1,1039 @@ +;;; ff-paths.el --- searches certain paths to find files. + +;; Copyright (C) 1994-2005 Peter S. Galbraith + +;; Author: Peter S. Galbraith +;; Created: 16 Sep 1994 +;; Version: 3.23 (Jul 08 2005) +;; Keywords: find-file, ffap, paths, search + +;;; This file is not part of GNU Emacs. + +;; This package 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 package 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. + +;; ---------------------------------------------------------------------------- +;;; Commentary: + +;; New versions of this package (if they exist) may be found at: +;; http://people.debian.org/~psg/elisp/ff-paths.el +;; or in the Debian package `emacs-goodies-el'. + +;; This code allows you to use C-x C-f normally most of the time, except that +;; if the requested file doesn't exist, it is checked against a list of +;; patterns for special paths to search for a file of the same name. +;; +;; Examples: +;; - a file extension of .bib will cause to search the path defined in +;; $BSTINPUTS or $BIBINPUTS for the file you requested. +;; - a file extension of .h will cause the /usr/include/ and +;; /usr/local/include/ directory trees to be searched. +;; - a file extension of .sty causes a search of TEXINPUTS and of all +;; directories below /usr/lib/texmf/tex/ +;; - a file extension of .el causes a search of the path set in the +;; emacs variable load-path. +;; - If the aboves searches don't return a match, the filename is searched +;; for using the `locate' command (if available on your system). +;; - gzip-compressed files (.gz) will also be found by ff-paths if +;; the package jka-compr is present. If you use some other package, +;; simply set the ff-paths-gzipped variable to t: + +;; If one file is found, or many files of the same name are found, then the +;; *completions* buffer is displayed with all possibilities, including the +;; non-existing path you first provided. Selecting it creates the new +;; file. +;; +;; This package runs as a find-file-not-found-hooks hook, and so will +;; happily live alongside other such file-finding mechanisms (e.g. +;; PC-look-for-include-file PC-try-load-many-files vc-file-not-found-hook) + +;; The patterns to test against filenames and the associated paths to search +;; for these files can be modified by the user by editing the variable +;; ff-paths-list defined below. + +;; I suggest that you use ffap.el by Michelangelo Grigni , +;; now part of GNU Emacs. His package will guess the filename from the +;; text under the editing point. It will search for an existing file in +;; various places before you even get the "File: " prompt. ff-paths will +;; provide itself to ffap as an additional tool to locate the file before +;; you ever see a prompt. ff-paths behaves slightly differently with ffap +;; than it does with find-file: if the file path selected under point by +;; ffap does not exist, it is not shown in the completions buffer along +;; with existing paths. If only one existing path is found for said file, +;; it is placed in the minibuffer at the ffap prompt. Also, since using +;; the `locate' command is fairly aggressive, it is not used in the ffap +;; toolkit. + +;;; Installation: +;; +;; ff-paths installs itself as a hook in find-file-not-found-hooks for +;; find-file. If ffap is installed, ff-paths installs itself as a toolbox +;; hook in ffap-alist (so load ff-paths after ffap). +;; +;; All you need to do is add this in ~/.emacs: +;; (require 'ff-paths) +;; (ff-paths-install) +;; or customize the variable `ff-paths-install' to enable it. +;; +;; NOTE: ff-paths used to install itself when it was loaded. It no longer +;; does so because that is against the Emacs coding conventions. +;; +;; +;; You may alter the value of the variables: +;; +;; ff-paths-list +;; ff-paths-use-locate +;; ff-paths-locate-max-matches +;; ff-paths-using-ms-windows +;; ff-paths-display-non-existent-filename +;; ff-paths-prompt-for-only-one-match +;; ff-paths-require-match +;; ff-paths-gzipped +;; +;; To see their documentation and current settings, do: +;; C-h v ff-paths-list +;; because that variable is _not_ customized, and also for all other +;; variables: +;; M-x customize-group ff-paths. + +;; ---------------------------------------------------------------------------- +;;; Change log: +;; +;; V1.01 16sep94 - created by Peter S. Galbraith, +;; rhogee@bathybius.meteo.mcgill.ca +;; V1.02 20sep94 - by Peter S. Galbraith +;; Change TeX-split-string to dired-split (thanks to Michelangelo Grigni) +;; Change variable name psg-ff-list to ff-paths-list +;; Added find-file-noselect-using-paths for ffap.el +;; Added ff-paths-prompt variable +;; V1.03 12oct94 - by Peter S. Galbraith +;; Fixed: +;; - error when nil appeared in ff-paths-list translation +;; (meaning current default) +;; - find-file-at-point would switch buffer if new file were not created. +;; V1.04 24oct94 - by Peter S. Galbraith +;; Added patch from Ziv Gigus to let environment variables +;; have trailing directory paths: +;; ("^foo_.*\\.[ch]$" "$FOO1:$FOO/bar:$FOO/barnone") +;; V2.00 05Jul95 - by Peter S. Galbraith +;; Reworked interface +;; Tremendous thanks to Bill Brodie for telling me how +;; to make completing-read start off with the completions buffer displayed. +;; It made this version possible without a kludge. Thanks Bill! +;; V2.01 05Jul95 - by Peter S. Galbraith +;; - Followed Bill Brodie's suggestions to make ff-paths-list not +;; necessarilly a colon-separated string, but rather usually a list +;; of strings: ("\\.bib$" "$BSTINPUTS:$BIBINPUTS") +;; -> ("\\.bib$" "$BSTINPUTS" "$BIBINPUTS") +;; - Also his suggestion to not quote symbols. +;; - Also his suggestion to include leftmost matches as initial string +;; to completing-read. +;; - Also, I substitute ~/ for the home directory if possible in the +;; matches displayed in the completions buffer. +;; V2.02 Jul 19 95 - Peter Galbraith +;; - Had introduced bug in search-directory-tree. synced with bib-cite.el. +;; V3.00 Jul 26 95 - Peter Galbraith +;; - Now a hook to find-file and ffap. Removed `create buffer?' prompt. +;; V3.01 Sep 13 95 +;; - dired-aux may not be loaded - Yoichi Konno +;; - added ff-paths-display-non-existent-filename +;; Jason Hatch +;; - psg-translate-ff-list was reversing directory order +;; Juergen Vollmer +;; V3.02 March 20 96 +;; dired-aux not in XEmacs - Vladimir Alexiev +;; V3.03 August 19 96 +;; ff-paths-prompt-for-only-one-match added. +;; Havard Fosseng +;; V3.04 August 26 96 Sudish Joseph (RCS 1.4) +;; - Use unread-command-events instead of unread-command-char. +;; V3.05 December 31 96 - Christoph Wedler +; (RCS 1.5) +;; - Use minibuffer-setup-hook instead of unread-command-events. +;; - Better minibuffer-quit. +;; - New variable `ff-paths-prompt' +;; - New variable `ff-paths-require-match' +;; - Changed from `dired-split' to copying AUCTeX's code. +;; V3.06 Janury 18 97 (RCS 1.6) +;; - Added the `locate' command functionality. +;; V3.07 July 16 97 (RCS 1.8) +;; - Added gzipped files +;; - Fixed infinite loop in recursive search with directory soft links +;; such as: /usr/include/ncurses -> . +;; V3.08 December 15 97 +;; - Hacked simpler create-alist-from-list (RCS 1.9) +;; - Handle file that exists but are not readable (RCS 1.10) +;; V3.09 December 17 97 (RCS 1.11) +;; - Added special face to completion buffer for non-existent filename. +;; V3.10 December 18 97 (RCS 1.13) +;; - Made V3.09 change work in XEmacs also. +;; V3.11 August 08 1998 (RCS 1.15) +;; - Compatible with GNU/Emacs compiled on NT/Win95 +;; V3.12 September 28 1998 (RCS 1.16) +;; - ff-paths-list can contain many entries for a filename match. +;; - ffap calls ff-paths on any filename (so users can modify ff-paths-list). +;; - ff-paths-locate validates filenames in case they have since been deleted +;; V3.13 November 12 1998 (RCS 1.17) +;; - Added ff-paths-use-locate equals 1 for high priority use. +;; - self-detection of locate for ntemacs. +;; V3.14 December 29 1999 (RCS 1.18) +;; - switch to GPL. +;; - psg-convert-homedir-to-tilde uses files.el's abbreviate-file-name +;; V3.15 October 02 2000 (RCS 1.19) +;; - spelling error: changed existant -> existent everywhere, affecting +;; user variables. Sorry. +;; V3.16 January 08 2001 (RCS 1.20) +;; - Added ff-paths-locate-max-matches, defaults to 20 matches. +;; V3.17 January 17 2001 (RCS 1.22) +;; - Oops! defvar ff-paths-locate-max-matches. +;; V3.18 January 07 2002 (RCS 1.24) Michael Ernst +;; Quote filenames before passing them to locate. Without this change, +;; ff-paths may return many irrelevant matches. More seriously, the +;; locate command may take a very long time to complete, if some portion +;; of the the filename matches many files. (I was given a file named +;; "procedure - version 1", and locate went to town on the "-".) +;; V3.19 April 21st 2003 PSG +;; - checkdoc cleaning. +;; - customization (still lacking the main variable `ff-paths-list'!) +;; - byte-compiles clean! +;; V3.20 June 16 2003 PSG +;; - Add /usr/X11R6/include// to ff-paths-list +;; - Add ff-paths-install to install this package (instead of doing so +;; automatically at load time). +;; - Add ff-paths-install defcustom to enable package. +;; V3.21 Aug 14 2003 PSG +;; - ff-paths-list-env: code cleanup. +;; V3.22 Nov 21 2003 PSG +;; - Add defcustoms `ff-paths-locate-ignore-filenames-default', +;; `ff-paths-locate-ignore-filenames' and `ff-paths-locate-ignore-regexps' +;; and support infracstructure to skip using locate for certain +;; (common) filenames. +;; V3.23 Jul 08 2005 Heath Morgan +;; - Reinsert `ff-paths-prompt-for-only-one-match' in XEmacs code. +;; ---------------------------------------------------------------------------- +;;; Code: + +(eval-when-compile (require 'cl)) + +(defgroup ff-paths nil + "Find file using paths." + :group 'ffap + :group 'matching + :group 'convenience) + +;; The following variable may be edited to suit your site: +;; Send me your interesting add-ons too! + +(defvar ff-paths-list + '(("\\.awk$" "$AWKPATH") ; awk files in AWKPATH env variable. + ("\\.bib$" "$BSTINPUTS" "$BIBINPUTS") ; bibtex files. + ("\\.\\(sty\\|cls\\)$" "$TEXINPUTS" "/usr/share/texmf/tex//") ;LaTeX files + ("\\.[h]+$" "/usr/local/include//" "/usr/include//" "/usr/X11R6/include//") + ("^\\." "~/") ; .* (dot) files in user's home + ("\\.el$" load-path)) ; el extension in load-path elisp var + "*List of paths to search for given file extension regexp's. +The directories can be: + - colon-separated directories and ENVIRONMENT variables + (which may also translate to colon-separated directories) + - list of strings representing directories or environment variables. + - a symbol object evaluating to a list of strings (e.g. `load-path') + +You may mix environment variables and directory paths together. +You may add trailing directory paths to environment variables, e.g. $HOME/bin +You may not mix strings with elisp lists (like `load-path'). +You may terminate a directory name with double slashes // indicating that + all subdirectories beneath it should also be searched.") + +;; Other variables + +(defvar ff-paths-prompt "Find File: " + "Prompt used by ff-paths.") + +(defvar ff-paths-have-reached-locate-max nil + "Internal to ff-paths to remember if max count is reached on this search.") + +(defvar ff-paths-in-ffap-name "" + "Filename used when `ff-paths-in-ffap' called. +Find-file-using-paths-hook does nothing if called with this same name to avoid +searching twice for a non-existing file the user actually wants to create") + +(defvar ff-paths-non-existent-filename nil + "Internal holder for a filename that doesn't exist on the filesystem.") + +;; ---------------------------------------------------------------------------- +;;; Installs itself as hooks at the end of the file +;; (so it won't if error in byte-compiling) + +;; ---------------------------------------------------------------------------- +;; Notes about ffap +;; +;; This defines two hooks: +;; - ff-paths-in-ffap used by ffap if it found a filename around point +;; which doesn't exist in the specified path or default directory. +;; - find-file-using-paths-hook used by find-file when the specific file +;; path does not exist. +;; +;; If ffap doesn't find a filename around point and prompts the user for a +;; filename and that file doesn't exist, ffap will not use its bag of +;; tricks to find the file (which would include ff-paths-in-ffap), but +;; will rather pass the filename directly to find-file, which will call +;; find-file-using-paths-hook. So both hooks are actually used. This is +;; ok, but I'll have to change things if ffap changes this behaviour. +;; +;; If ffap finds a filename around point but said file does not exit, ffap +;; will use ff-paths-in-ffap (as part of its toolbox) to locate the file. +;; I do not include the non-existent file as a possible completion because +;; ffap cannot readily deal with this. If only one file is found it is +;; returned to ffap, which will prompt the user using it as an initial +;; string. If no files are found, ff-paths-in-ffap recurses through +;; directory paths ending in // to try again. If two or more files are +;; found, ff-paths-in-ffap will use the completions buffer to ask which +;; the user wants, and returns it to ffap. Unfortunately, ffap doesn't +;; know any better than to prompt the user again with this filename. + +;; If ffap and ff-paths-in-ffap both fail, ffap will pass the argument to +;; vanilla find-file and find-file-using-paths-hook will be called down +;; the line because the file does not exist. find-file-using-paths-hook +;; checks if called with same filename (which will also be same as +;; ffap-string-at-point) and doesn't do anything if it is. This handles +;; the case where the user actually wanted to create this new file. + +;; ff-paths-in-ffap can't let the user edit completions to some +;; non-existing file because ffap will check for existence, crush the +;; choice and display a fresh prompt. + +(defvar ff-paths-is-XEmacs + (not (null (save-match-data (string-match "XEmacs\\|Lucid" emacs-version))))) + +;;FIXME: Should use defface if using Emacs-20 +(defvar ff-paths-non-existent-file-face 'ff-paths-non-existent-file-face + "Face to use for message marked for deletion in mh-e folder-mode.") +(make-face 'ff-paths-non-existent-file-face) +(if ff-paths-is-XEmacs + (make-face-bold 'ff-paths-non-existent-file-face nil) + (make-face-bold 'ff-paths-non-existent-file-face nil t)) +(set-face-foreground 'ff-paths-non-existent-file-face "NavyBlue" nil) + +(defvar buf) +(defvar truename) +(defvar number) +(defvar filename) + +(defvar ff-paths-use-locate) +(defvar ff-paths-display-non-existent-filename) +(defvar ff-paths-require-match) +(defvar ff-paths-locate-max-matches) +(defvar ff-paths-gzipped) +(defvar ff-paths-using-ms-windows) +(defvar ff-paths-locate-ignore-filenames-compiled) +(defvar ff-paths-locate-ignore-filenames-default) +(defvar ff-paths-locate-ignore-filenames) +(defvar ff-paths-locate-ignore-regexps) + +(defun find-file-using-paths-hook () + "Search for file not found in path specified by the variable `ff-paths-list'." + ;; This is called by find-file after it fails. + ;; find-file can itself be called by ffap if no string was under point. + (if (or (ff-paths-file-exists-but-cannot-be-read buffer-file-name) + (string-equal buffer-file-name ff-paths-in-ffap-name)) + nil + (let* ((the-name (file-name-nondirectory buffer-file-name)) + (matches + (or (if (and (equal ff-paths-use-locate '1) + (ff-paths-locate-filename-p the-name)) + (ff-paths-locate the-name)) + (psg-filename-in-directory-list + the-name (ff-paths-from-list the-name)) + (if (and (equal ff-paths-use-locate 't) + (ff-paths-locate-filename-p the-name)) + (ff-paths-locate the-name)))) + (bufname (buffer-name buf)) ; compute before uniquify hits! + newbuf) + (if (null matches) + nil ;Return nil + (if (not ff-paths-display-non-existent-filename) + (setq matches (psg-convert-homedir-to-tilde matches)) + (setq matches (psg-convert-homedir-to-tilde + (cons (expand-file-name buffer-file-name) matches))) + (setq ff-paths-non-existent-filename + (car (psg-convert-homedir-to-tilde (list buffer-file-name))))) + +;;From: Christoph Wedler +;; * The code of automatically displaying the *Completion* Buffer doesn't work +;; in XEmacs 19.13 (this is fixed in the patch below, ffap did something +;; similar--but I prefer `cons'ing to `minibuffer-setup-hook' instead of +;; setting this hook) + +;; Replace this: +;; (let ((unread-command-char ??)) +;; (setq the-name +;; (if (and (not ff-paths-prompt-for-only-one-match) +;; (null (cdr matches))) +;; (car matches) +;; (or (and (string-equal "18" (substring emacs-version 0 2)) +;; (completing-read "Find file: " +;; (create-alist-from-list matches) +;; nil nil +;; (psg-common-in-list matches))) +;; (completing-read "Find file: " +;; (create-alist-from-list matches) +;; nil nil +;; (psg-common-in-list matches) +;; 'file-name-history))))) +;; + +;; With this: + (condition-case nil + (let ((minibuffer-setup-hook (cons 'minibuffer-completion-help + minibuffer-setup-hook)) + (completion-setup-hook + (append (symbol-value 'completion-setup-hook) + (list 'ff-paths-fontify-non-existent-filename + 'ff-paths-display-locate-max-reached)))) + (setq the-name + ;; Heath Morgan pointed out that + ;; `ff-paths-prompt-for-only-one-match' had been dropped. + ;; Added back in V3.23 + (if (and (not ff-paths-prompt-for-only-one-match) + (null (cdr matches))) + (car matches) + (or (and (string-equal "18" (substring emacs-version 0 2)) + (completing-read ff-paths-prompt + (create-alist-from-list matches) + nil ff-paths-require-match + (psg-common-in-list matches))) + (completing-read ff-paths-prompt + (create-alist-from-list matches) + nil ff-paths-require-match + (psg-common-in-list matches) + 'file-name-history))))) + (quit (setq the-name nil))) +;; End of Christoph Wedler's change. + + (if (or (not the-name) + (string-equal "" the-name) + (not (file-exists-p the-name))) + nil ;Return nil + (let ((find-file-hooks)) ;Don't call hooks twice +; (funcall 'find-file (expand-file-name the-name)))))))) + (setq newbuf (set-buffer (find-file-noselect the-name)))) + (kill-buffer buf) + (rename-buffer bufname) + ;; Side-effect variables of parent find-file-noselect + (setq buf newbuf + filename buffer-file-name + truename buffer-file-truename + number buffer-file-number) + t))))) + +(defun ff-paths-fontify-non-existent-filename () + "Fontify the non-existing filename in *Completions* if using `window-system'." + (cond + ((and window-system + ff-paths-display-non-existent-filename + (boundp 'ff-paths-non-existent-filename) + ff-paths-non-existent-filename) + (save-excursion + (set-buffer standard-output) + (goto-char (point-min)) + (if (search-forward ff-paths-non-existent-filename nil t) + (progn + (put-text-property (match-beginning 0) (match-end 0) + 'face 'ff-paths-non-existent-file-face) + (goto-char (point-min)) + (if (search-forward "Possible completions are:" nil t) + (forward-line -1)) + (let ((the-start (point)) + (buffer-read-only nil)) + (insert "The filename in this face is the path you requested and does not exist.\n") + (put-text-property the-start (point) + 'face 'ff-paths-non-existent-file-face)))))))) + +(defun ff-paths-display-locate-max-reached () + "Add a line in completions buffer to say that locate maximum is reached." + (if ff-paths-have-reached-locate-max + (save-excursion + (set-buffer standard-output) + (goto-char (point-min)) + (if (search-forward "Possible completions are:" nil t) + (forward-line -1)) + (let ((buffer-read-only nil)) + (insert "Only the first " + (int-to-string ff-paths-locate-max-matches) + " matches are listed.\n")))) + (setq ff-paths-have-reached-locate-max nil)) + +(defun ff-paths-file-exists-but-cannot-be-read (file-name) + "Return t if FILE-NAME exists but cannot be Read. +`find-file' calls `find-file-not-found-hooks' when this is the case, but I +don't think it should. ff-paths should deal with it anyway..." + (and (file-exists-p file-name) + (not (file-readable-p file-name)))) + +(defun ff-paths-in-ffap (name) + "Search for NAME in path specified in `ff-paths-list'." + ;; This is called by ffap before it prompts. + (setq ff-paths-in-ffap-name (expand-file-name name)) + (let* ((the-name (file-name-nondirectory name)) + (matches (psg-filename-in-directory-list + the-name (ff-paths-from-list the-name)))) + (cond + ((null matches) ; No match, Return nil + nil) + ((null (cdr matches)) ; Single matche + (car matches)) + (t + (setq matches (psg-convert-homedir-to-tilde matches)) + (condition-case nil + (let ((minibuffer-setup-hook (cons 'minibuffer-completion-help + minibuffer-setup-hook))) + (setq the-name + (or (and (string-equal "18" (substring emacs-version 0 2)) + (completing-read ff-paths-prompt + (create-alist-from-list matches) + nil t + (psg-common-in-list matches))) + (completing-read ff-paths-prompt + (create-alist-from-list matches) + nil t + (psg-common-in-list matches) + 'file-name-history)))) + (quit (setq the-name nil))) + (if (and the-name + (not (string-equal "" the-name))) + the-name + nil))))) + +(defvar ffap-alist) + +;;(defun ff-paths-in-ffap-install () +;; "Install ff-paths in ffap toolbox to find files from name under point" +;; (cond +;; ((and (boundp 'ffap-alist) +;; (not (member +;; (cons "\\(^\\.\\)\\|\\.\\(awk\\|bib\\|sty\\|cls\\|[h]+\\|el\\)$" +;; 'ff-paths-in-ffap) +;; ffap-alist))) +;; (setq ffap-alist +;; (nconc +;; ffap-alist +;; (list +;; (cons "\\(^\\.\\)\\|\\.\\(awk\\|bib\\|sty\\|cls\\|[h]+\\|el\\)$" +;; 'ff-paths-in-ffap))))))) + +;; FIXME: Either make ffap call ff-paths on any file like here, or build a +;; regexp from ff-paths-list +(defun ff-paths-in-ffap-install () + "Install ff-paths in ffap toolbox to find files from name under point." + (cond + ((and (boundp 'ffap-alist) + (not (member '("." . ff-paths-in-ffap) ffap-alist))) + (setq ffap-alist (append ffap-alist '(("." . ff-paths-in-ffap))))))) + +;; There must be a command to do this! +(defun psg-common-in-list (list) + "Return STRING with same beginnings in all strings in LIST." + (let* ((first-string (car list)) + (work-list (cdr list)) + (match-len (length first-string))) + (while work-list + (let ((i 1)) + (while (and (<= i match-len) + (<= i (length (car work-list))) + (string-equal (substring first-string 0 i) + (substring (car work-list) 0 i)) + (setq i (1+ i)))) + (setq match-len (1- i))) + (setq work-list (cdr work-list))) + (substring first-string 0 match-len))) + +(defun psg-convert-homedir-to-tilde (list) + "Shorten LIST elements by substituting teh home directory by tilde." + (let* ((work-list list)(result-list) + (homedir (concat "^" (file-name-as-directory + (expand-file-name "~")))) + (the-length (1- (length homedir)))) + (while work-list + (if (fboundp 'abbreviate-file-name) + (setq result-list + (cons (abbreviate-file-name (car work-list)) result-list)) + (if (string-match homedir (car work-list)) + (setq result-list + (cons (concat "~/" (substring (car work-list) the-length)) + result-list)) + (setq result-list (cons (car work-list) result-list)))) + (setq work-list (cdr work-list))) + (nreverse result-list))) + +;; Defined in bib-cite.el ! +(defun create-alist-from-list (the-list) + (mapcar 'list the-list)) + +(defun psg-filename-in-directory-list (filename list) + "Check for presence of FILENAME in directory LIST. Return all found. +If none found, recurse through directory tree of directories ending in // +and return all matches." + ;;USAGE: (psg-filename-in-directory-list "emacs" (ff-paths-list-env "PATH")) + ;;USAGE: (psg-filename-in-directory-list "ff-paths.el" load-path) + ;;USAGE: (psg-filename-in-directory-list "ff-paths.el" (ff-paths-from-list "ff-paths.el")) + (let ((the-list list) (filespec-list)) + (while the-list + (let* ((directory (or (and (not (car the-list)) ; list item is nil -> ~/ + "~/") + (substring (car the-list) + 0 + (string-match "//$" (car the-list))))) + ;; This removed trailing // if any + (filespec (expand-file-name filename directory))) + (if (file-exists-p filespec) + (setq filespec-list (cons filespec filespec-list))) + (if (and ff-paths-gzipped + (file-exists-p (concat filespec ".gz"))) + (setq filespec-list (cons (concat filespec ".gz") filespec-list)))) + (setq the-list (cdr the-list))) + (if filespec-list + filespec-list + ;; If I have not found a file yet, then check if some directories + ;; ended in // and recurse through them. + (let ((the-list list)) + (while the-list + (if (or (not (car the-list)) ; `nil' case + (not (string-match "//$" (car the-list)))) nil + (setq filespec-list + (append + filespec-list + (search-directory-tree + (substring (car the-list) 0 (match-beginning 0)) + (if ff-paths-gzipped + (concat "^" filename "\\(.gz\\)?$") + (concat "^" filename "$")) + t + nil)))) + (setq the-list (cdr the-list)))) + filespec-list))) + +;;; search-directory-tree is heavily based on TeX-search-files +;; which recursively searches a list of directories for files +;; matching a list of extensions. This simplified version should +;; be a wee bit faster and will suit my purposes (for bib-cite's +;; need to search directories listed in BIBINPUTS recursively +;; if they end in //). +;; TeX-search-files is part of auc-tex: +;; Maintainer: Per Abrahamsen + +;; Copyright (C) 1985, 1986 Free Software Foundation, Inc. +;; Copyright (C) 1987 Lars Peter Fischer +;; Copyright (C) 1991 Kresten Krab Thorup +;; Copyright (C) 1993, 1994 Per Abrahamsen + +;; Also defined in bib-cite.el ! +(defun search-directory-tree (directories extension-regexp recurse first-file) + "Return recursive list of files in DIRECTORIES ending with EXTENSION-REGEXP. +DIRECTORIES is a list or a single-directory string +EXTENSION-REGEXP is actually (any) regexp, usually \\\\.bib$ +If RECURSE is t, then we will recurse into the directory tree, + nil, we will only search the list given. +If FIRST-FILE is t, stop after first file is found." + (or (listp directories) + (setq directories (list directories))) + + (let ((match) + (directories-done)) + (while directories + (let* ((directory (file-name-as-directory (car directories))) + (content (and directory + (file-readable-p directory) + (ff-paths-file-directory-p directory) + (directory-files directory)))) + (setq directories (cdr directories)) + (setq directories-done (cons directory directories-done)) + (while content + (let ((file (expand-file-name (car content) directory))) + (cond ((string-match "[.]+$" (car content))) ;This or parent dir + ((not (file-readable-p file))) + ((and recurse + (ff-paths-file-directory-p file)) + (if (not (member + (file-name-as-directory (file-chase-links file)) + directories-done)) + (setq directories + (cons + (file-name-as-directory (file-chase-links file)) + directories)))) + ((string-match extension-regexp + (file-name-nondirectory file)) + (and first-file + (setq content nil + directories nil)) + (setq match (cons file match))))) + (setq content (cdr content))))) + match)) + + +(defun ff-paths-split-path (string) + "Split a path STRING such as \"/some/directory:/some/other\". +The returned list is like (\"/some/directory\" \"/some/other\"." + (let ((splitter (or (and ff-paths-using-ms-windows ";") ":"))) + (ff-paths-split-string splitter string))) + +;; copied from auctex's TeX-split-string +(defun ff-paths-split-string (regexp string) + "Return a list of strings given a REGEXP and a STRING. +The string is split into sections which were seperated by REGEXP. + +Examples: + + (ff-paths-split-string \"\:\" \"abc:def:ghi\") + -> (\"abc\" \"def\" \"ghi\") + + (ff-paths-split-string \" *\" \"dvips -Plw -p3 -c4 testfile.dvi\") + + -> (\"dvips\" \"-Plw\" \"-p3\" \"-c4\" \"testfile.dvi\") + +If REGEXP is nil, or \"\", an error will occur." + + (let ((start 0) + (result '())) + (while (string-match regexp string start) + (let ((match (string-match regexp string start))) + (setq result (cons (substring string start match) result)) + (setq start (match-end 0)))) + (setq result (cons (substring string start nil) result)) + (nreverse result))) + +;; `ff-paths-from-list' and `ff-paths-expand-path' together replace +;; the old `psg-translate-ff-list' +(defun ff-paths-from-list (filename) + "Given a FILENAME, return corresponding directory list from `ff-paths-list'. +Return nil if file name extension is not listed in `ff-paths-list'. +So translate the cdr of the `ff-paths-list' entry to a directory list. +NOTE: returned nil means no match, but nil as an element of the returned list + is valid, meaning current-directory!" + (let ((local-ff-list ff-paths-list)(the-path)) + (while local-ff-list + (let ((the-pair (car local-ff-list))) + (cond + ((string-match (car the-pair) filename) + (setq the-path + (append the-path (ff-paths-expand-path (cdr the-pair)))))) + (setq local-ff-list (cdr local-ff-list)))) + the-path)) + +(defun ff-paths-expand-path (unexpanded-path) + "UNEXPANDED-PATH is expanded. +It should hold a list of: + no match -> nil + symbol -> (load-path) + stringed PATH -> (\"/usr/local/include//:/usr/include//\") + many such strings -> (\"/usr/local/include//\" \"/usr/include//\") + appended env var -> (\"$FOO/bar\")" + (cond + ((not unexpanded-path) ; nil case, and we're done. + nil) + ((symbolp (car unexpanded-path)) ; load-path type symbol + (eval (car unexpanded-path))) ; ->Return it, and we're done. + (t ;string case, expand each element + (let ((the-list)) + (while unexpanded-path + (let ((the-elements (ff-paths-split-path (car unexpanded-path))) + (path-list) (element)) + (while the-elements + (setq element (car the-elements)) + (setq the-elements (cdr the-elements)) + (if (string-match "^\\$" element) ; an ENVIRONMENT var? + (setq path-list + (nconc path-list + (ff-paths-list-env (substring element 1)))) + (if (ff-paths-file-directory-p element) ; Add only if it exists + (setq path-list (cons element path-list))))) + (if path-list + (setq the-list (append the-list path-list)))) + (setq unexpanded-path (cdr unexpanded-path))) + the-list)))) + +(defun ff-paths-list-env (env) + "Return a list of directory elements in ENV variable (w/o leading $) +argument may consist of environment variable plus a trailing directory, e.g. +HOME or HOME/bin" + (let* ((slash-pos (string-match "/" env)) + (value (if (not slash-pos) + (getenv env) + (concat (getenv (substring env 0 slash-pos)) + (substring env slash-pos)))) + (entries (and value (ff-paths-split-path value)))) + (loop for x in entries if (ff-paths-file-directory-p x) collect x))) + +(defun ff-paths-file-directory-p (file) + "Like default `file-directory-p' but allow FILE to end in // for ms-windows." + (save-match-data + (if (string-match "\\(.*\\)//$" file) + (file-directory-p (match-string 1 file)) + (file-directory-p file)))) + +;;; `locate' stuff + +(defun ff-paths-locate (filename) + "Try finding FILENAME using the locate command. +Return a string if a single match, or a list if many matches." + (let ((ff-buffer (get-buffer-create "*ff-paths-locate*")) + status matches + (count 0)) + (save-excursion + (set-buffer ff-buffer) + (setq status + (call-process "sh" nil t nil "-c" + (concat "locate " (shell-quote-argument filename)))) + (goto-char 1) + (if (eq status 1) + nil ;Not found... + (while (and (or (not (boundp 'ff-paths-locate-max-matches)) + (not ff-paths-locate-max-matches) + (> ff-paths-locate-max-matches count)) + (re-search-forward (if (and (boundp 'ff-paths-gzipped) + ff-paths-gzipped) + (concat "/" filename "\\(.gz\\)?$") + (concat "/" filename "$")) + nil t)) + (let ((the-file (buffer-substring (progn (beginning-of-line)(point)) + (progn (end-of-line)(point))))) + (setq count (1+ count)) + (if (and (file-exists-p the-file) + (not (file-directory-p the-file))) + (setq matches (cond ((not matches) + (list the-file)) + (t + (cons the-file matches)))))))) + (if (and (boundp 'ff-paths-locate-max-matches) + ff-paths-locate-max-matches + (<= ff-paths-locate-max-matches count)) + (setq ff-paths-have-reached-locate-max t)) + (kill-buffer ff-buffer) + matches))) + +(defun ff-paths-locate-filename-p (filename) + "Return t if ff-paths should try to find FILENAME using locate command. +Checks FILENAME against `ff-paths-locate-ignore-filenames', +`ff-paths-locate-ignore-filenames-default' and +`ff-paths-locate-ignore-regexps'." + (cond + ((string-match ff-paths-locate-ignore-filenames-compiled filename) + nil) + (t + (not (car (memq t + (mapcar (lambda (x) (not (null (string-match x filename)))) + ff-paths-locate-ignore-regexps))))))) + +(defun ff-paths-have-locate () + "Determine if the `locate' command exists on this system." + (if (not (condition-case nil + (not (call-process "sh" nil 0 nil)) + (error))) + nil ;No `sh' command on system + (cond + ((and (fboundp 'executable-find) + (executable-find "locate")) + t) + ((ff-paths-locate "bin/locate") + t) + ((ff-paths-locate "locate.exe") + t) + (t + nil)))) + +;;;###autoload +(defun ff-paths-install () + "Install ff-paths as a `find-file-not-found-hooks' and to ffap package." + (add-hook 'find-file-not-found-hooks 'find-file-using-paths-hook t) + (ff-paths-in-ffap-install)) + +(defcustom ff-paths-install nil + "Whether to setup ff-paths for use. +find-file-using-paths searches certain paths to find files." + :type 'boolean + :set (lambda (symbol value) + (set-default symbol value) + (when value + (ff-paths-install))) + :require 'ff-paths + :group 'ff-paths) + +(defcustom ff-paths-use-ffap nil + "Whether to setup ffap and its key bindings for use. + +Usually packages don't advertise or try to setup other packages, but +ff-paths works well in combination with ffap (Find FILENAME, guessing a +default from text around point) and so I recommend it here. + +find-file-using-paths searches certain paths to find files." + :type 'boolean + :set (lambda (symbol value) + (set-default symbol value) + (when value + (require 'ffap) + (ffap-bindings) + (ff-paths-in-ffap-install))) + :require 'ff-paths + :group 'ff-paths) + +(defcustom ff-paths-use-locate (ff-paths-have-locate) + "*Determines whether the `locate' command is used by ff-paths. +If nil don't use it. +If t use it but only if other ff-paths methods have failed. +If 1 use it before any other mechanism (because it's faster). + +To set it to 1, add this to your ~/.emacs file: + + (setq ff-paths-use-locate '1) + +By default, this is set to t if it can be determined that your system has +the locate command. +Using locate is fairly aggressive, and so is *not* added to the ffap toolkit." + :group 'ff-paths + :type 'boolean) + +(defcustom ff-paths-display-non-existent-filename t + "*find-file-using-paths-hook displays the prompted-for non-existent filename. +If you use \"C-x C-f article.sty\" in a path where it does not exists, +find-file-using-paths-hook will presumably find it for you. If this variable +is set, then this non-existent filename will be displayed in the completions +buffer along with the existing found file. This makes it more intuitive +in case you really wanted to create the new file (instead of pressing C-g +to create the new file)." + :group 'ff-paths + :type 'boolean) + +(defcustom ff-paths-prompt-for-only-one-match t + "*If non-nil, prompt the user for filename even if there is only one match. +If nil and `ff-paths-display-non-existent-filename' is also nil, then dispense +with confirmation prompt when a single match is found for a non-existent file +and edit that single matched file immediately." + :group 'ff-paths + :type 'boolean) + +(defvar ff-paths-locate-ignore-filenames-compiled nil + "*Regexp matching files not searched for using locate. +Do not alter this variable directly. Instead, customize +`ff-paths-locate-ignore-filenames-default' checking off filenames normally +not searched that you would like searched, and add extra filenames to +not search for in `ff-paths-locate-ignore-filenames'.") + +(defun ff-paths-locate-ignore-filenames-compile () + "Make or remake the variable `ff-paths-locate-ignore-filenames-compiled'. +Done using `ff-paths-locate-ignore-filenames' and +`ff-paths-locate-ignore-filenames-default' as input." + (let ((list (cond + ((and (boundp 'ff-paths-locate-ignore-filenames) + ff-paths-locate-ignore-filenames + (boundp 'ff-paths-locate-ignore-filenames-default) + ff-paths-locate-ignore-filenames-default) + (append ff-paths-locate-ignore-filenames + ff-paths-locate-ignore-filenames-default)) + ((and (boundp 'ff-paths-locate-ignore-filenames) + ff-paths-locate-ignore-filenames) + ff-paths-locate-ignore-filenames) + ((and (boundp 'ff-paths-locate-ignore-filenames-default) + ff-paths-locate-ignore-filenames-default) + ff-paths-locate-ignore-filenames-default)))) + (if list + (setq ff-paths-locate-ignore-filenames-compiled + (concat + "^" + ;; workaround for insufficient default + (let ((max-specpdl-size 1000)) + (regexp-opt list t)) + "$")) + (setq ff-paths-locate-ignore-filenames-compiled nil)))) + +(defcustom ff-paths-locate-ignore-filenames-default + '("ChangeLog" + "changelog" + "changelog.gz" + "changelog.Debian.gz" + "copyright" + "README" + "README.Debian" + "README.Debian.gz") + "A customizable list of filenames to not search for using locate. +Usually a list of very common filenames. + +See also `ff-paths-locate-ignore-filenames' and +`ff-paths-locate-ignore-regexps'" + :type '(set + (const "ChangeLog") + (const "changelog") + (const "changelog.gz") + (const "changelog.Debian.gz") + (const "copyright") + (const "README") + (const "README.Debian") + (const "README.Debian.gz")) + :set (lambda (symbol value) + (set-default symbol value) + (ff-paths-locate-ignore-filenames-compile)) + :group 'ff-paths) + +(defcustom ff-paths-locate-ignore-filenames nil + "*Additional filenames to not search for using locate. +Filenames that you would like the locate search to skip that aren't listed in +`ff-paths-locate-ignore-filenames-default' can be added to this option with the +caveat that regular expressions are not allowed. + +See also `ff-paths-locate-ignore-regexps'" + :type '(repeat (string :tag "Filename:")) + :set (lambda (symbol value) + (set-default symbol value) + (ff-paths-locate-ignore-filenames-compile)) + :group 'ff-paths) + +(defcustom ff-paths-locate-ignore-regexps nil + "*Additional regexps matching filenames to not search for using locate. +Add regular expressions matching filenames that are not to be +searched suing the system locate command here (because the names +are too common to be useful). + +See also `ff-paths-locate-ignore-filenames-default' and +`ff-paths-locate-ignore-filenames'." + :type '(repeat (regexp :tag "Regular expression:")) + :group 'ff-paths) + +(defcustom ff-paths-require-match nil + "*Whether user has to choose one of the listed files. +This is the argument REQUIRE-MATCH of `completing-read'." + :group 'ff-paths + :type 'boolean) + +(defcustom ff-paths-gzipped (featurep 'jka-compr) + "*Search for gzipped-compressed file as well." + :group 'ff-paths + :type 'boolean) + +(defcustom ff-paths-using-ms-windows (and (boundp 'system-type) + (equal system-type 'windows-nt)) + "*Set to t if using DOS, win95, winNT, etc. +The effect is to set path splitting on the \";\" character instead of \":\"" + :group 'ff-paths + :type 'boolean) + +(defcustom ff-paths-locate-max-matches 20 + "*Maximum number of matches to extract from locate command. +Only this number of mtaches will be displayed and all next matches will be +ignored. If set to nil, any number of matches will be processed but be +warned that this can take some time (for example, I have 939 files called +changelog.Debian.gz on my system)" + :group 'ff-paths + :type 'integer) + +(provide 'ff-paths) +;;; ff-paths.el ends here diff --git a/elisp/emacs-goodies-el/filladapt.el b/elisp/emacs-goodies-el/filladapt.el new file mode 100755 index 0000000..4ae63ab --- /dev/null +++ b/elisp/emacs-goodies-el/filladapt.el @@ -0,0 +1,981 @@ +;;; Adaptive fill +;;; Copyright (C) 1989, 1995-1998 Kyle E. Jones +;;; +;;; This program is free software; you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 2, or (at your option) +;;; any later version. +;;; +;;; This program is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; A copy of the GNU General Public License can be obtained from this +;;; program's author (send electronic mail to kyle@uunet.uu.net) or from +;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA +;;; 02139, USA. +;;; +;;; Send bug reports to kyle_jones@wonderworks.com + +;; LCD Archive Entry: +;; filladapt|Kyle Jones|kyle_jones@wonderworks.com| +;; Minor mode to adaptively set fill-prefix and overload filling functions| +;; 28-February-1998|2.12|~/packages/filladapt.el| + +;; These functions enhance the default behavior of Emacs' Auto Fill +;; mode and the commands fill-paragraph, lisp-fill-paragraph, +;; fill-region-as-paragraph and fill-region. +;; +;; The chief improvement is that the beginning of a line to be +;; filled is examined and, based on information gathered, an +;; appropriate value for fill-prefix is constructed. Also the +;; boundaries of the current paragraph are located. This occurs +;; only if the fill prefix is not already non-nil. +;; +;; The net result of this is that blurbs of text that are offset +;; from left margin by asterisks, dashes, and/or spaces, numbered +;; examples, included text from USENET news articles, etc. are +;; generally filled correctly with no fuss. +;; +;; Since this package replaces existing Emacs functions, it cannot +;; be autoloaded. Save this in a file named filladapt.el in a +;; Lisp directory that Emacs knows about, byte-compile it and put +;; (require 'filladapt) +;; in your .emacs file. +;; +;; Note that in this release Filladapt mode is a minor mode and it is +;; _off_ by default. If you want it to be on by default, use +;; (setq-default filladapt-mode t) +;; +;; M-x filladapt-mode toggles Filladapt mode on/off in the current +;; buffer. +;; +;; Use +;; (add-hook 'text-mode-hook 'turn-on-filladapt-mode) +;; to have Filladapt always enabled in Text mode. +;; +;; Use +;; (add-hook 'c-mode-hook 'turn-off-filladapt-mode) +;; to have Filladapt always disabled in C mode. +;; +;; In many cases, you can extend Filladapt by adding appropriate +;; entries to the following three `defvar's. See `postscript-comment' +;; or `texinfo-comment' as a sample of what needs to be done. +;; +;; filladapt-token-table +;; filladapt-token-match-table +;; filladapt-token-conversion-table + +(and (featurep 'filladapt) + (error "filladapt cannot be loaded twice in the same Emacs session.")) + +(provide 'filladapt) + +(defvar filladapt-version "2.12" + "Version string for filladapt.") + +;; BLOB to make custom stuff work even without customize +(eval-and-compile + (condition-case () + (require 'custom) + (error nil)) + (if (and (featurep 'custom) (fboundp 'custom-declare-variable)) + nil ;; We've got what we needed + ;; We have the old custom-library, hack around it! + (defmacro defgroup (&rest args) + nil) + (defmacro defcustom (var value doc &rest args) + (` (defvar (, var) (, value) (, doc)))))) + +(defgroup filladapt nil + "Enhanced filling" + :group 'fill) + +(defvar filladapt-mode nil + "Non-nil means that Filladapt minor mode is enabled. +Use the filladapt-mode command to toggle the mode on/off.") +(make-variable-buffer-local 'filladapt-mode) + +(defcustom filladapt-mode-line-string " Filladapt" + "*String to display in the modeline when Filladapt mode is active. +Set this to nil if you don't want a modeline indicator for Filladapt." + :type 'string + :group 'filladapt) + +(defcustom filladapt-fill-column-tolerance nil + "*Tolerate filled paragraph lines ending this far from the fill column. +If any lines other than the last paragraph line end at a column +less than fill-column - filladapt-fill-column-tolerance, fill-column will +be adjusted using the filladapt-fill-column-*-fuzz variables and +the paragraph will be re-filled until the tolerance is achieved +or filladapt runs out of fuzz values to try. + +A nil value means behave normally, that is, don't try refilling +paragraphs to make filled line lengths fit within any particular +range." + :type '(choice (const nil) + integer) + :group 'filladapt) + +(defcustom filladapt-fill-column-forward-fuzz 5 + "*Try values from fill-column to fill-column plus this variable +when trying to make filled paragraph lines fall with the tolerance +range specified by filladapt-fill-column-tolerance." + :type 'integer + :group 'filladapt) + +(defcustom filladapt-fill-column-backward-fuzz 5 + "*Try values from fill-column to fill-column minus this variable +when trying to make filled paragraph lines fall with the tolerance +range specified by filladapt-fill-column-tolerance." + :type 'integer + :group 'filladapt) + +;; install on minor-mode-alist +(or (assq 'filladapt-mode minor-mode-alist) + (setq minor-mode-alist (cons (list 'filladapt-mode + 'filladapt-mode-line-string) + minor-mode-alist))) + +(defcustom filladapt-token-table + '( + ;; this must be first + ("^" beginning-of-line) + ;; Included text in news or mail replies + (">+" citation->) + ;; Included text generated by SUPERCITE. We can't hope to match all + ;; the possible variations, your mileage may vary. + ("\\(\\w\\|[0-9]\\)[^'`\"< \t\n]*>[ \t]*" supercite-citation) + ;; Lisp comments + (";+" lisp-comment) + ;; UNIX shell comments + ("#+" sh-comment) + ;; Postscript comments + ("%+" postscript-comment) + ;; C++ comments + ("///*" c++-comment) + ;; Texinfo comments + ("@c[ \t]" texinfo-comment) + ("@comment[ \t]" texinfo-comment) + ;; Bullet types. + ;; + ;; LaTex \item + ;; + ("\\\\item[ \t]" bullet) + ;; + ;; 1. xxxxx + ;; xxxxx + ;; + ("[0-9]+\\.[ \t]" bullet) + ;; + ;; 2.1.3 xxxxx xx x xx x + ;; xxx + ;; + ("[0-9]+\\(\\.[0-9]+\\)+[ \t]" bullet) + ;; + ;; a. xxxxxx xx + ;; xxx xxx + ;; + ("[A-Za-z]\\.[ \t]" bullet) + ;; + ;; 1) xxxx x xx x xx or (1) xx xx x x xx xx + ;; xx xx xxxx xxx xx x x xx x + ;; + ("(?[0-9]+)[ \t]" bullet) + ;; + ;; a) xxxx x xx x xx or (a) xx xx x x xx xx + ;; xx xx xxxx xxx xx x x xx x + ;; + ("(?[A-Za-z])[ \t]" bullet) + ;; + ;; 2a. xx x xxx x x xxx + ;; xxx xx x xx x + ;; + ("[0-9]+[A-Za-z]\\.[ \t]" bullet) + ;; + ;; 1a) xxxx x xx x xx or (1a) xx xx x x xx xx + ;; xx xx xxxx xxx xx x x xx x + ;; + ("(?[0-9]+[A-Za-z])[ \t]" bullet) + ;; + ;; - xx xxx xxxx or * xx xx x xxx xxx + ;; xxx xx xx x xxx x xx x x x + ;; + ("[-~*+]+[ \t]" bullet) + ;; + ;; o xx xxx xxxx xx x xx xxx x xxx xx x xxx + ;; xxx xx xx + ;; + ("o[ \t]" bullet) + ;; don't touch + ("[ \t]+" space) + ("$" end-of-line) + ) + "Table of tokens filladapt knows about. +Format is + + ((REGEXP SYM) ...) + +filladapt uses this table to build a tokenized representation of +the beginning of the current line. Each REGEXP is matched +against the beginning of the line until a match is found. +Matching is done case-sensitively. The corresponding SYM is +added to the list, point is moved to (match-end 0) and the +process is repeated. The process ends when there is no REGEXP in +the table that matches what is at point." + :type '(repeat (list regexp symbol)) + :group 'filladapt) + +(defcustom filladapt-not-token-table + '( + "[Ee]\\.g\\.[ \t,]" + "[Ii]\\.e\\.[ \t,]" + ;; end-of-line isn't a token if whole line is empty + "^$" + ) + "List of regexps that can never be a token. +Before trying the regular expressions in filladapt-token-table, +the regexps in this list are tried. If any regexp in this list +matches what is at point then the token generator gives up and +doesn't try any of the regexps in filladapt-token-table. + +Regexp matching is done case-sensitively." + :type '(repeat regexp) + :group 'filladapt) + +(defcustom filladapt-token-match-table + '( + (citation-> citation->) + (supercite-citation supercite-citation) + (lisp-comment lisp-comment) + (sh-comment sh-comment) + (postscript-comment postscript-comment) + (c++-comment c++-comment) + (texinfo-comment texinfo-comment) + (bullet) + (space bullet space) + (beginning-of-line beginning-of-line) + ) + "Table describing what tokens a certain token will match. + +To decide whether a line belongs in the current paragraph, +filladapt creates a token list for the fill prefix of both lines. +Tokens and the columns where tokens end are compared. This table +specifies what a certain token will match. + +Table format is + + (SYM [SYM1 [SYM2 ...]]) + +The first symbol SYM is the token, subsequent symbols are the +tokens that SYM will match." + :type '(repeat (repeat symbol)) + :group 'filladapt) + +(defcustom filladapt-token-match-many-table + '( + space + ) + "List of tokens that can match multiple tokens. +If one of these tokens appears in a token list, it will eat all +matching tokens in a token list being matched against it until it +encounters a token that doesn't match or a token that ends on +a greater column number." + :type '(repeat symbol) + :group 'filladapt) + +(defcustom filladapt-token-paragraph-start-table + '( + bullet + ) + "List of tokens that indicate the start of a paragraph. +If parsing a line generates a token list containing one of +these tokens, then the line is considered to be the start of a +paragraph." + :type '(repeat symbol) + :group 'filladapt) + +(defcustom filladapt-token-conversion-table + '( + (citation-> . exact) + (supercite-citation . exact) + (lisp-comment . exact) + (sh-comment . exact) + (postscript-comment . exact) + (c++-comment . exact) + (texinfo-comment . exact) + (bullet . spaces) + (space . exact) + (end-of-line . exact) + ) + "Table that specifies how to convert a token into a fill prefix. +Table format is + + ((SYM . HOWTO) ...) + +SYM is the symbol naming the token to be converted. +HOWTO specifies how to do the conversion. + `exact' means copy the token's string directly into the fill prefix. + `spaces' means convert all characters in the token string that are + not a TAB or a space into spaces and copy the resulting string into + the fill prefix." + :type '(repeat (cons symbol (choice (const exact) + (const spaces)))) + :group 'filladapt) + +(defvar filladapt-function-table + (let ((assoc-list + (list (cons 'fill-paragraph (symbol-function 'fill-paragraph)) + (cons 'fill-region (symbol-function 'fill-region)) + (cons 'fill-region-as-paragraph + (symbol-function 'fill-region-as-paragraph)) + (cons 'do-auto-fill (symbol-function 'do-auto-fill))))) + ;; v18 Emacs doesn't have lisp-fill-paragraph + (if (fboundp 'lisp-fill-paragraph) + (nconc assoc-list + (list (cons 'lisp-fill-paragraph + (symbol-function 'lisp-fill-paragraph))))) + assoc-list ) + "Table containing the old function definitions that filladapt usurps.") + +(defcustom filladapt-fill-paragraph-post-hook nil + "Hooks run after filladapt runs fill-paragraph." + :type 'hook + :group 'filladapt) + +(defvar filladapt-inside-filladapt nil + "Non-nil if the filladapt version of a fill function executing. +Currently this is only checked by the filladapt version of +fill-region-as-paragraph to avoid this infinite recursion: + + fill-region-as-paragraph -> fill-paragraph -> fill-region-as-paragraph ...") + +(defcustom filladapt-debug nil + "Non-nil means filladapt debugging is enabled. +Use the filladapt-debug command to turn on debugging. + +With debugging enabled, filladapt will + + a. display the proposed indentation with the tokens highlighted + using filladapt-debug-indentation-face-1 and + filladapt-debug-indentation-face-2. + b. display the current paragraph using the face specified by + filladapt-debug-paragraph-face." + :type 'boolean + :group 'filladapt) + +(if filladapt-debug + (add-hook 'post-command-hook 'filladapt-display-debug-info-maybe)) + +(defvar filladapt-debug-indentation-face-1 'highlight + "Face used to display the indentation when debugging is enabled.") + +(defvar filladapt-debug-indentation-face-2 'secondary-selection + "Another face used to display the indentation when debugging is enabled.") + +(defvar filladapt-debug-paragraph-face 'bold + "Face used to display the current paragraph when debugging is enabled.") + +(defvar filladapt-debug-indentation-extents nil) +(make-variable-buffer-local 'filladapt-debug-indentation-extents) +(defvar filladapt-debug-paragraph-extent nil) +(make-variable-buffer-local 'filladapt-debug-paragraph-extent) + +;; kludge city, see references in code. +(defvar filladapt-old-line-prefix) + +(defun do-auto-fill () + (catch 'done + (if (and filladapt-mode (null fill-prefix)) + (save-restriction + (let ((paragraph-ignore-fill-prefix nil) + ;; if the user wanted this stuff, they probably + ;; wouldn't be using filladapt-mode. + (adaptive-fill-mode nil) + (adaptive-fill-regexp nil) + ;; need this or Emacs 19 ignores fill-prefix when + ;; inside a comment. + (comment-multi-line t) + (filladapt-inside-filladapt t) + fill-prefix retval) + (if (filladapt-adapt nil nil) + (progn + (setq retval (filladapt-funcall 'do-auto-fill)) + (throw 'done retval)))))) + (filladapt-funcall 'do-auto-fill))) + +(defun filladapt-fill-paragraph (function arg) + (catch 'done + (if (and filladapt-mode (null fill-prefix)) + (save-restriction + (let ((paragraph-ignore-fill-prefix nil) + ;; if the user wanted this stuff, they probably + ;; wouldn't be using filladapt-mode. + (adaptive-fill-mode nil) + (adaptive-fill-regexp nil) + ;; need this or Emacs 19 ignores fill-prefix when + ;; inside a comment. + (comment-multi-line t) + fill-prefix retval) + (if (filladapt-adapt t nil) + (progn + (if filladapt-fill-column-tolerance + (let* ((low (- fill-column + filladapt-fill-column-backward-fuzz)) + (high (+ fill-column + filladapt-fill-column-forward-fuzz)) + (old-fill-column fill-column) + (fill-column fill-column) + (lim (- high low)) + (done nil) + (sign 1) + (delta 0)) + (while (not done) + (setq retval (filladapt-funcall function arg)) + (if (filladapt-paragraph-within-fill-tolerance) + (setq done 'success) + (setq delta (1+ delta) + sign (* sign -1) + fill-column (+ fill-column (* delta sign))) + (while (and (<= delta lim) + (or (< fill-column low) + (> fill-column high))) + (setq delta (1+ delta) + sign (* sign -1) + fill-column (+ fill-column + (* delta sign)))) + (setq done (> delta lim)))) + ;; if the paragraph lines never fell + ;; within the tolerances, refill using + ;; the old fill-column. + (if (not (eq done 'success)) + (let ((fill-column old-fill-column)) + (setq retval (filladapt-funcall function arg))))) + (setq retval (filladapt-funcall function arg))) + (run-hooks 'filladapt-fill-paragraph-post-hook) + (throw 'done retval)))))) + ;; filladapt-adapt failed, so do fill-paragraph normally. + (filladapt-funcall function arg))) + +(defun fill-paragraph (arg) + "Fill paragraph at or after point. Prefix arg means justify as well. + +(This function has been overloaded with the `filladapt' version.) + +If `sentence-end-double-space' is non-nil, then period followed by one +space does not end a sentence, so don't break a line there. + +If `fill-paragraph-function' is non-nil, we call it (passing our +argument to it), and if it returns non-nil, we simply return its value." + (interactive "*P") + (let ((filladapt-inside-filladapt t)) + (filladapt-fill-paragraph 'fill-paragraph arg))) + +(defun lisp-fill-paragraph (&optional arg) + "Like \\[fill-paragraph], but handle Emacs Lisp comments. + +(This function has been overloaded with the `filladapt' version.) + +If any of the current line is a comment, fill the comment or the +paragraph of it that point is in, preserving the comment's indentation +and initial semicolons." + (interactive "*P") + (let ((filladapt-inside-filladapt t)) + (filladapt-fill-paragraph 'lisp-fill-paragraph arg))) + +(defun fill-region-as-paragraph (beg end &optional justify + nosqueeze squeeze-after) + "Fill the region as one paragraph. + +(This function has been overloaded with the `filladapt' version.) + +It removes any paragraph breaks in the region and extra newlines at the end, +indents and fills lines between the margins given by the +`current-left-margin' and `current-fill-column' functions. +It leaves point at the beginning of the line following the paragraph. + +Normally performs justification according to the `current-justification' +function, but with a prefix arg, does full justification instead. + +From a program, optional third arg JUSTIFY can specify any type of +justification. Fourth arg NOSQUEEZE non-nil means not to make spaces +between words canonical before filling. Fifth arg SQUEEZE-AFTER, if non-nil, +means don't canonicalize spaces before that position. + +If `sentence-end-double-space' is non-nil, then period followed by one +space does not end a sentence, so don't break a line there." + (interactive "*r\nP") + (if (and filladapt-mode (not filladapt-inside-filladapt)) + (save-restriction + (narrow-to-region beg end) + (let ((filladapt-inside-filladapt t) + line-start last-token) + (goto-char beg) + (while (equal (char-after (point)) ?\n) + (delete-char 1)) + (end-of-line) + (while (zerop (forward-line)) + (if (setq last-token + (car (filladapt-tail (filladapt-parse-prefixes)))) + (progn + (setq line-start (point)) + (move-to-column (nth 1 last-token)) + (delete-region line-start (point)))) + ;; Dance... + ;; + ;; Do this instead of (delete-char -1) to keep + ;; markers on the correct side of the whitespace. + (goto-char (1- (point))) + (insert " ") + (delete-char 1) + + (end-of-line)) + (goto-char beg) + (fill-paragraph justify)) + ;; In XEmacs 19.12 and Emacs 18.59 fill-region relies on + ;; fill-region-as-paragraph to do this. If we don't do + ;; it, fill-region will spin in an endless loop. + (goto-char (point-max))) + (condition-case nil + ;; five args for Emacs 19.31 + (filladapt-funcall 'fill-region-as-paragraph beg end + justify nosqueeze squeeze-after) + (wrong-number-of-arguments + (condition-case nil + ;; four args for Emacs 19.29 + (filladapt-funcall 'fill-region-as-paragraph beg end + justify nosqueeze) + ;; three args for the rest of the world. + (wrong-number-of-arguments + (filladapt-funcall 'fill-region-as-paragraph beg end justify))))))) + +(defun fill-region (beg end &optional justify nosqueeze to-eop) + "Fill each of the paragraphs in the region. + +(This function has been overloaded with the `filladapt' version.) + +Prefix arg (non-nil third arg, if called from program) means justify as well. + +Noninteractively, fourth arg NOSQUEEZE non-nil means to leave +whitespace other than line breaks untouched, and fifth arg TO-EOP +non-nil means to keep filling to the end of the paragraph (or next +hard newline, if `use-hard-newlines' is on). + +If `sentence-end-double-space' is non-nil, then period followed by one +space does not end a sentence, so don't break a line there." + (interactive "*r\nP") + (if (and filladapt-mode (not filladapt-inside-filladapt)) + (save-restriction + (narrow-to-region beg end) + (let ((filladapt-inside-filladapt t) + start) + (goto-char beg) + (while (not (eobp)) + (setq start (point)) + (while (and (not (eobp)) (not (filladapt-parse-prefixes))) + (forward-line 1)) + (if (not (equal start (point))) + (progn + (save-restriction + (narrow-to-region start (point)) + (fill-region start (point) justify nosqueeze to-eop) + (goto-char (point-max))) + (if (and (not (bolp)) (not (eobp))) + (forward-line 1)))) + (if (filladapt-parse-prefixes) + (progn + (save-restriction + ;; for the clipping region + (filladapt-adapt t t) + (fill-paragraph justify) + (goto-char (point-max))) + (if (and (not (bolp)) (not (eobp))) + (forward-line 1))))))) + (condition-case nil + (filladapt-funcall 'fill-region beg end justify nosqueeze to-eop) + (wrong-number-of-arguments + (condition-case nil + (filladapt-funcall 'fill-region beg end justify nosqueeze) + (wrong-number-of-arguments + (filladapt-funcall 'fill-region beg end justify))))))) + +(defvar zmacs-region-stays) ; for XEmacs + +(defun filladapt-mode (&optional arg) + "Toggle Filladapt minor mode. +With arg, turn Filladapt mode on iff arg is positive. When +Filladapt mode is enabled, auto-fill-mode and the fill-paragraph +command are both smarter about guessing a proper fill-prefix and +finding paragraph boundaries when bulleted and indented lines and +paragraphs are used." + (interactive "P") + ;; don't deactivate the region. + (setq zmacs-region-stays t) + (setq filladapt-mode (or (and arg (> (prefix-numeric-value arg) 0)) + (and (null arg) (null filladapt-mode)))) + (if (fboundp 'force-mode-line-update) + (force-mode-line-update) + (set-buffer-modified-p (buffer-modified-p)))) + +(defun turn-on-filladapt-mode () + "Unconditionally turn on Filladapt mode in the current buffer." + (filladapt-mode 1)) + +(defun turn-off-filladapt-mode () + "Unconditionally turn off Filladapt mode in the current buffer." + (filladapt-mode -1)) + +(defun filladapt-funcall (function &rest args) + "Call the old definition of a function that filladapt has usurped." + (apply (cdr (assoc function filladapt-function-table)) args)) + +(defun filladapt-paragraph-start (list) + "Returns non-nil if LIST contains a paragraph starting token. +LIST should be a token list as returned by filladapt-parse-prefixes." + (catch 'done + (while list + (if (memq (car (car list)) filladapt-token-paragraph-start-table) + (throw 'done t)) + (setq list (cdr list))))) + +(defun filladapt-parse-prefixes () + "Parse all the tokens after point and return a list of them. +The tokens regular expressions are specified in +filladapt-token-table. The list returned is of this form + + ((SYM COL STRING) ...) + +SYM is a token symbol as found in filladapt-token-table. +COL is the column at which the token ended. +STRING is the token's text." + (save-excursion + (let ((token-list nil) + (done nil) + (old-point (point)) + (case-fold-search nil) + token-table not-token-table moved) + (catch 'done + (while (not done) + (setq not-token-table filladapt-not-token-table) + (while not-token-table + (if (looking-at (car not-token-table)) + (throw 'done t)) + (setq not-token-table (cdr not-token-table))) + (setq token-table filladapt-token-table + done t) + (while token-table + (if (null (looking-at (car (car token-table)))) + (setq token-table (cdr token-table)) + (goto-char (match-end 0)) + (setq token-list (cons (list (nth 1 (car token-table)) + (current-column) + (buffer-substring + (match-beginning 0) + (match-end 0))) + token-list) + moved (not (eq (point) old-point)) + token-table (if moved nil (cdr token-table)) + done (not moved) + old-point (point)))))) + (nreverse token-list)))) + +(defun filladapt-tokens-match-p (list1 list2) + "Compare two token lists and return non-nil if they match, nil otherwise. +The lists are walked through in lockstep, comparing tokens. + +When two tokens A and B are compared, they are considered to +match if + + 1. A appears in B's list of matching tokens or + B appears in A's list of matching tokens +and + 2. A and B both end at the same column + or + A can match multiple tokens and ends at a column > than B + or + B can match multiple tokens and ends at a column > than A + +In the case where the end columns differ the list pointer for the +token with the greater end column is not moved forward, which +allows its current token to be matched against the next token in +the other list in the next iteration of the matching loop. + +All tokens must be matched in order for the lists to be considered +matching." + (let ((matched t) + (done nil)) + (while (and (not done) list1 list2) + (let* ((token1 (car (car list1))) + (token1-matches-many-p + (memq token1 filladapt-token-match-many-table)) + (token1-matches (cdr (assq token1 filladapt-token-match-table))) + (token1-endcol (nth 1 (car list1))) + (token2 (car (car list2))) + (token2-matches-many-p + (memq token2 filladapt-token-match-many-table)) + (token2-matches (cdr (assq token2 filladapt-token-match-table))) + (token2-endcol (nth 1 (car list2))) + (tokens-match (or (memq token1 token2-matches) + (memq token2 token1-matches)))) + (cond ((not tokens-match) + (setq matched nil + done t)) + ((and token1-matches-many-p token2-matches-many-p) + (cond ((= token1-endcol token2-endcol) + (setq list1 (cdr list1) + list2 (cdr list2))) + ((< token1-endcol token2-endcol) + (setq list1 (cdr list1))) + (t + (setq list2 (cdr list2))))) + (token1-matches-many-p + (cond ((= token1-endcol token2-endcol) + (setq list1 (cdr list1) + list2 (cdr list2))) + ((< token1-endcol token2-endcol) + (setq matched nil + done t)) + (t + (setq list2 (cdr list2))))) + (token2-matches-many-p + (cond ((= token1-endcol token2-endcol) + (setq list1 (cdr list1) + list2 (cdr list2))) + ((< token2-endcol token1-endcol) + (setq matched nil + done t)) + (t + (setq list1 (cdr list1))))) + ((= token1-endcol token2-endcol) + (setq list1 (cdr list1) + list2 (cdr list2))) + (t + (setq matched nil + done t))))) + (and matched (null list1) (null list2)) )) + +(defun filladapt-make-fill-prefix (list) + "Build a fill-prefix for a token LIST. +filladapt-token-conversion-table specifies how this is done." + (let ((prefix-list nil) + (conversion-spec nil)) + (while list + (setq conversion-spec (cdr (assq (car (car list)) + filladapt-token-conversion-table))) + (cond ((eq conversion-spec 'spaces) + (setq prefix-list + (cons + (filladapt-convert-to-spaces (nth 2 (car list))) + prefix-list))) + ((eq conversion-spec 'exact) + (setq prefix-list + (cons + (nth 2 (car list)) + prefix-list)))) + (setq list (cdr list))) + (apply (function concat) (nreverse prefix-list)) )) + +(defun filladapt-paragraph-within-fill-tolerance () + (catch 'done + (save-excursion + (let ((low (- fill-column filladapt-fill-column-tolerance)) + (shortline nil)) + (goto-char (point-min)) + (while (not (eobp)) + (if shortline + (throw 'done nil) + (end-of-line) + (setq shortline (< (current-column) low)) + (forward-line 1))) + t )))) + +(defun filladapt-convert-to-spaces (string) + "Return a copy of STRING, with all non-tabs and non-space changed to spaces." + (let ((i 0) + (space-list '(?\ ?\t)) + (space ?\ ) + (lim (length string))) + (setq string (copy-sequence string)) + (while (< i lim) + (if (not (memq (aref string i) space-list)) + (aset string i space)) + (setq i (1+ i))) + string )) + +(defun filladapt-adapt (paragraph debugging) + "Set fill-prefix based on the contents of the current line. + +If the first arg PARAGRAPH is non-nil, also set a clipping region +around the current paragraph. + +If the second arg DEBUGGING is non-nil, don't do the kludge that's +necessary to make certain paragraph fills work properly." + (save-excursion + (beginning-of-line) + (let ((token-list (filladapt-parse-prefixes)) + curr-list done) + (if (null token-list) + nil + (setq fill-prefix (filladapt-make-fill-prefix token-list)) + (if paragraph + (let (beg end) + (if (filladapt-paragraph-start token-list) + (setq beg (point)) + (save-excursion + (setq done nil) + (while (not done) + (cond ((not (= 0 (forward-line -1))) + (setq done t + beg (point))) + ((not (filladapt-tokens-match-p + token-list + (setq curr-list (filladapt-parse-prefixes)))) + (forward-line 1) + (setq done t + beg (point))) + ((filladapt-paragraph-start curr-list) + (setq done t + beg (point))))))) + (save-excursion + (setq done nil) + (while (not done) + (cond ((not (= 0 (progn (end-of-line) (forward-line 1)))) + (setq done t + end (point))) + ((not (filladapt-tokens-match-p + token-list + (setq curr-list (filladapt-parse-prefixes)))) + (setq done t + end (point))) + ((filladapt-paragraph-start curr-list) + (setq done t + end (point)))))) + (narrow-to-region beg end) + ;; Multiple spaces after the bullet at the start of + ;; a hanging list paragraph get squashed by + ;; fill-paragraph. We kludge around this by + ;; replacing the line prefix with the fill-prefix + ;; used by the rest of the lines in the paragraph. + ;; fill-paragraph will not alter the fill prefix so + ;; we win. The post hook restores the old line prefix + ;; after fill-paragraph has been called. + (if (and paragraph (not debugging)) + (let (col) + (setq col (nth 1 (car (filladapt-tail token-list)))) + (goto-char (point-min)) + (move-to-column col) + (setq filladapt-old-line-prefix + (buffer-substring (point-min) (point))) + (delete-region (point-min) (point)) + (insert fill-prefix) + (add-hook 'filladapt-fill-paragraph-post-hook + 'filladapt-cleanup-kludge-at-point-min))))) + t )))) + +(defun filladapt-cleanup-kludge-at-point-min () + "Cleanup the paragraph fill kludge. +See filladapt-adapt." + (save-excursion + (goto-char (point-min)) + (insert filladapt-old-line-prefix) + (delete-char (length fill-prefix)) + (remove-hook 'filladapt-fill-paragraph-post-hook + 'filladapt-cleanup-kludge-at-point-min))) + +(defun filladapt-tail (list) + "Returns the last cons in LIST." + (if (null list) + nil + (while (consp (cdr list)) + (setq list (cdr list))) + list )) + +(defun filladapt-delete-extent (e) + (if (fboundp 'delete-extent) + (delete-extent e) + (delete-overlay e))) + +(defun filladapt-make-extent (beg end) + (if (fboundp 'make-extent) + (make-extent beg end) + (make-overlay beg end))) + +(defun filladapt-set-extent-endpoints (e beg end) + (if (fboundp 'set-extent-endpoints) + (set-extent-endpoints e beg end) + (move-overlay e beg end))) + +(defun filladapt-set-extent-property (e prop val) + (if (fboundp 'set-extent-property) + (set-extent-property e prop val) + (overlay-put e prop val))) + +(defun filladapt-debug () + "Toggle filladapt debugging on/off in the current buffer." +;; (interactive) + (make-local-variable 'filladapt-debug) + (setq filladapt-debug (not filladapt-debug)) + (if (null filladapt-debug) + (progn + (mapcar (function (lambda (e) (filladapt-set-extent-endpoints e 1 1))) + filladapt-debug-indentation-extents) + (if filladapt-debug-paragraph-extent + (progn + (filladapt-delete-extent filladapt-debug-paragraph-extent) + (setq filladapt-debug-paragraph-extent nil))))) + (add-hook 'post-command-hook 'filladapt-display-debug-info-maybe)) + +(defun filladapt-display-debug-info-maybe () + (cond ((null filladapt-debug) nil) + (fill-prefix nil) + (t + (if (null filladapt-debug-paragraph-extent) + (let ((e (filladapt-make-extent 1 1))) + (filladapt-set-extent-property e 'detachable nil) + (filladapt-set-extent-property e 'evaporate nil) + (filladapt-set-extent-property e 'face + filladapt-debug-paragraph-face) + (setq filladapt-debug-paragraph-extent e))) + (save-excursion + (save-restriction + (let ((ei-list filladapt-debug-indentation-extents) + (ep filladapt-debug-paragraph-extent) + (face filladapt-debug-indentation-face-1) + fill-prefix token-list) + (if (null (filladapt-adapt t t)) + (progn + (filladapt-set-extent-endpoints ep 1 1) + (while ei-list + (filladapt-set-extent-endpoints (car ei-list) 1 1) + (setq ei-list (cdr ei-list)))) + (filladapt-set-extent-endpoints ep (point-min) (point-max)) + (beginning-of-line) + (setq token-list (filladapt-parse-prefixes)) + (message "(%s)" (mapconcat (function + (lambda (q) (symbol-name (car q)))) + token-list + " ")) + (while token-list + (if ei-list + (setq e (car ei-list) + ei-list (cdr ei-list)) + (setq e (filladapt-make-extent 1 1)) + (filladapt-set-extent-property e 'detachable nil) + (filladapt-set-extent-property e 'evaporate nil) + (setq filladapt-debug-indentation-extents + (cons e filladapt-debug-indentation-extents))) + (filladapt-set-extent-property e 'face face) + (filladapt-set-extent-endpoints e (point) + (progn + (move-to-column + (nth 1 + (car token-list))) + (point))) + (if (eq face filladapt-debug-indentation-face-1) + (setq face filladapt-debug-indentation-face-2) + (setq face filladapt-debug-indentation-face-1)) + (setq token-list (cdr token-list))) + (while ei-list + (filladapt-set-extent-endpoints (car ei-list) 1 1) + (setq ei-list (cdr ei-list)))))))))) diff --git a/elisp/emacs-goodies-el/floatbg.el b/elisp/emacs-goodies-el/floatbg.el new file mode 100755 index 0000000..ef6b23b --- /dev/null +++ b/elisp/emacs-goodies-el/floatbg.el @@ -0,0 +1,205 @@ +;;; floatbg.el --- slowly modify background color + +;; Copyright (C) 2001 John Paul Wallington + +;; Author: John Paul Wallington +;; Created: 07 Nov 2001 +;; Version: 0.5, 11 Nov 2001 +;; Keywords: background frames faces + +;; This file isn't part of 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, 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: + +;; Modifies backgound color by moving through an hsv color model, like +;; floatbg for X-Windows by Jan Rekers. + +;; Installation: +;; Put floatbg.el somewhere in your load-path. +;; Put the following two lines in your .emacs file: +;; (require 'floatbg) +;; (floatbg-mode t) + + +;;; Code: + + +(defgroup floatbg nil + "Slowly modify background color by moving through an HSV color model." + :tag "Floating Background" + :group 'frames + :prefix "floatbg-") + + +(defcustom floatbg-mode nil + "Toggle `floatbg-mode' on/off." + :type 'boolean + :tag "Toggle floatbg-mode on/off." + :initialize 'custom-initialize-default + :set (lambda (symbol value) (floatbg-mode value)) + :require 'floatbg + :group 'floatbg) + + +(defcustom floatbg-delay 15 + "* Delay in seconds before changing color." + :type 'number + :group 'floatbg) + + +(defcustom floatbg-increment 1 + "* Size of increment of Hue in degrees when changing color." + :type 'number + :group 'floatbg) + + +(defcustom floatbg-initial-hue t + "* Initial value of Hue (in HSV model) in degrees." + :type '(choice integer + (const :tag "Derived from time of day" t) + (const :tag "Random" nil)) + :group 'floatbg) + + +(defun floatbg-set-val (symbol value) + (if (and (numberp value) + (< 0.0 value) + (< value 1.0)) + (set-default symbol value) + (error "please set %s to more than 0.0 and less than 1.0" + (symbol-name symbol)))) + + +(defcustom floatbg-initial-val 0.88 + "* Initial value of Value (in HSV model); should be > 0.0 and < 1.0." + :type '(number :tag "Number more than 0.0 and less than 1.0") + :set 'floatbg-set-val + :group 'floatbg) + + +(defvar floatbg-smid 0.375) +(defvar floatbg-svar 0.125) +(defvar floatbg-sfinhf 0.25) + + +(defun floatbg-set-sinus-shape (symbol value) + (let ((smid (car value)) + (svar (car (cdr value))) + (sfinhf (car (nthcdr 2 value)))) + (unless (null value) + (if (and (>= 1 (- smid svar)) + (>= 1 (+ smid svar)) + (<= 0 (- smid svar)) + (<= 0 (+ smid svar))) + (setq floatbg-smid smid + floatbg-svar svar + floatbg-sfinhf sfinhf) + (error "Invalid parameters."))))) + + +(defcustom floatbg-sinus-shape nil + "* The sinus shape. + Unquoted list containing smid, svar and sfinhf parameters. + The default is (0.375 0.125 0.25). + smid + svar and smid - svar should fall between 0 and 1." + :type '(choice (const :tag "Default" nil) + (sexp :tag "Specify List")) + :set 'floatbg-set-sinus-shape + :group 'floatbg) + + +(defcustom floatbg-reset-on-toggle nil + "* Reset colors to initial values when toggling `floatbg-mode'?" + :type '(choice (const :tag "Yes" t) + (const :tag "No" nil)) + :group 'floatbg) + + +(defvar floatbg-timer nil + "Timer handle for floatbg mode.") + + +(defun floatbg-initial-hue () + (if (equal floatbg-initial-hue t) + (* (1+ (car (nthcdr 2 (decode-time)))) 15) + (or floatbg-initial-hue (random 360)))) + + +(defvar floatbg-hue (floatbg-initial-hue)) +(defvar floatbg-sat) +(defvar floatbg-val floatbg-initial-val) + + +;;;###autoload +(defun floatbg-mode (&optional arg) + "Toggle floatbg mode" + (interactive "P") + (if floatbg-timer (cancel-timer floatbg-timer)) + (when (setq floatbg-mode + (if (null arg) + (not floatbg-mode) + (> (prefix-numeric-value arg) 0))) + (if floatbg-reset-on-toggle + (floatbg-reset-initial-values)) + (setq floatbg-timer + (run-at-time 1 floatbg-delay 'floatbg-change))) + (message "floatbg-mode now %s" (if floatbg-mode "on" "off"))) + + +(defun floatbg-change () + "Change background color, imperceptibly." + (setq floatbg-hue (mod (+ floatbg-hue floatbg-increment) 360) + floatbg-sat (- floatbg-smid + (* floatbg-svar + (sin (* (/ pi 180) floatbg-sfinhf floatbg-hue))))) + (let ((background + (floatbg-hsv-to-rgb-string floatbg-hue floatbg-sat floatbg-val)) + (frames (frame-list))) + (while frames + (modify-frame-parameters (car frames) + (list (cons 'background-color background))) + (setq frames (cdr frames))) + (set-face-background 'default background))) + + +(defun floatbg-hsv-to-rgb-string (h s v) + "Convert color in HSV values to RGB string." + (setq h (degrees-to-radians h)) + (let (r g b) + (if (zerop s) + (setq r v g v b v) + (let* ((h (/ (if (>= h (* 2 pi)) 0.0 h) + (/ pi 3))) + (i (truncate h)) + (f (- h i))) + (let ((p (* v (- 1.0 s))) + (q (* v (- 1.0 (* s f)))) + (z (* v (- 1.0 (* s (- 1.0 f)))))) + (cond ((eq i 0) (setq r v g z b p)) + ((eq i 1) (setq r q g v b p)) + ((eq i 2) (setq r p g v b z)) + ((eq i 3) (setq r p g q b v)) + ((eq i 4) (setq r z g p b v)) + ((eq i 5) (setq r v g p b q)))))) + (format "#%.2X%.2X%.2X" (* r 255) (* g 255) (* b 255)))) + + +(defun floatbg-reset-initial-values () + "Reset floatbg colors to initial values." + (interactive) + (setq floatbg-hue (floatbg-initial-hue) + floatbg-val floatbg-initial-val)) + + +(provide 'floatbg) +;;; floatbg.el ends here diff --git a/elisp/emacs-goodies-el/folding.el b/elisp/emacs-goodies-el/folding.el new file mode 100755 index 0000000..fce5c59 --- /dev/null +++ b/elisp/emacs-goodies-el/folding.el @@ -0,0 +1,5413 @@ +;;; folding.el --- A folding-editor-like minor mode. + +;; This file is not part of Emacs + +;; Copyright (C) 2000-2013 Jari Aalto +;; Copyright (C) 1995, 1996, 1997, 1998, 1999 Jari Aalto, Anders Lindgren. +;; Copyright (C) 1994 Jari Aalto +;; Copyright (C) 1992, 1993 Jamie Lokier, All rights reserved. +;; +;; Authors: Jamie Lokier +;; Jari Aalto +;; Anders Lindgren +;; Maintainer: Jari Aalto +;; Created: 1992 +;; Keywords: tools +;; +;; [Latest devel version] +;; Vcs-URL: http://savannah.nongnu.org/projects/emacs-tiny-tools + +(defconst folding-version-time "2013.0613.1821" + "Last edit time in format YYYY.MMDD.HHMM.") + +;;{{{ GPL + +;; 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, +;; or (at your option) any later version. +;; +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . +;; +;; Visit for more information + +;;}}} + +;;; Commentary: + +;;{{{ Introduction + +;; Preface +;; +;; This package provides a minor mode, compatible with all major +;; editing modes, for folding (hiding) parts of the edited text or +;; program. +;; +;; Folding mode handles a document as a tree, where each branch +;; is bounded by special markers `{{{' and `}}}'. A branch can be +;; placed inside another branch, creating a complete hierarchical +;; structure. +;; +;; Folding mode can CLOSE a fold, leaving only the initial `{{{' +;; and possibly a comment visible. +;; +;; It can also ENTER a fold, which means that only the current +;; fold will be visible, all text above `{{{' and below `}}}' +;; will be invisible. +;; +;; Please note, that the maintainers do not recommend to use only +;; folding for you your code layout and navigation. Folding.el is +;; on its best when it can "chunk" large sections of code inside +;; folds. The larger the chunks, the more the usability of +;; folding will increase. Folding.el is not meant to hide +;; individual functions: you may be better served by hideshow.el +;; or imenu.el (which can parse the function indexes) + +;;}}} +;;{{{ Installation + +;; Installation +;; +;; To install Folding mode, put this file (folding.el) on your +;; Emacs `load-path' (or extend the load path to include the +;; directory containing this file) and optionally byte compile it. +;; +;; The best way to install folding is the autoload installation, +;; so that folding is loaded into your emacs only when you turn on +;; `folding-mode'. This statement speeds up loading your .emacs +;; +;; (autoload 'folding-mode "folding" "Folding mode" t) +;; (autoload 'turn-off-folding-mode "folding" "Folding mode" t) +;; (autoload 'turn-on-folding-mode "folding" "Folding mode" t) +;; +;; But if you always use folding, then perhaps you want more +;; traditional installation. Here Folding mode starts +;; automatically when you load a folded file. +;; +;; ;; (setq folding-default-keys-function +;; ;; 'folding-bind-backward-compatible-keys) +;; +;; (if (load "folding" 'nomessage 'noerror) +;; (folding-mode-add-find-file-hook)) +;; +;; Folding uses a keymap which conforms with the new Emacs +;; (started 19.29) style. The key bindings are prefixed with +;; "C-c@" instead of old "C-c". To use the old keyboard bindings, +;; uncomment the lines in the the above installation example +;; +;; The same folding marks can be used in `vim' editor command +;; "set fdm=marker". +;; +;; Uninstallation +;; +;; To remove folding, call `M-x' `folding-uninstall'. +;; +;; To read the manual +;; +;; At any point you can reach the manual with `M-x' +;; `finder-commentary' RET folding RET. + +;;}}} +;;{{{ DOCUMENTATION + +;; Compatibility +;; +;; Folding supports following Emacs flavors: +;; +;; Unix Emacs 19.28+ and Win32 Emacs 19.34+ +;; Unix XEmacs 19.14+ and Win32 XEmacs 21.0+ +;; +;; Compatibility not for old NT Emacs releases +;; +;; NOTE: folding version starting from 2.47 gets around this bug +;; by using adviced kill/yank functions. The advice functions are +;; only instantiated under problematic NT Emacs versions. +;; +;; Windows NT/9x 19.34 - 20.3.1 (i386-*-nt4.0) versions contained +;; a bug which affected using folding. At the time the bug was +;; reported by Trey Jackson +;; +;; If you kill folded area and yank it back, the ^M marks are +;; removed for some reason. +;; +;; Before kill +;; ;;{{{ fold... +;; +;; After yank +;; ;;{{{ fold all lines together }}} +;; +;; Relates packages or modes +;; +;; Folding.el was designed to be a content organizer and it is most +;; suitable for big files. Sometimes people misunderstand the +;; package's capabilities and try to use folding.el in wrong places, +;; where some other package would do a better job. Trying to wrap +;; individual functions inside fold-marks is not where folding is +;; it's best. Grouping several functions inside a logical fold-block +;; in the other is. So, to choose a best tool for your need, +;; here are some suggestions,: +;; +;; o Navigating between or hiding individual functions - +;; use combination of imenu.el, speedbar.el and +;; hideshow.el +;; o Organizing large blocks - use folding.el +;; o For text, `outline-mode' is more non-intrusive than folding. +;; Look at Emacs NEWS file (`C-x' `n') and you can see beatifully +;; laid content. +;; +;; Tutorial +;; +;; To start folding mode, give the command: `M-x' `folding-mode' +;; `RET'. The mode line should contain the string "Fld" indicating +;; that folding mode is activated. +;; +;; When loading a document containing fold marks, Folding mode is +;; automatically started and all folds are closed. For example when +;; loading my init file, only the following lines (plus a few lines +;; of comments) are visible: +;; +;; ;;{{{ General... +;; ;;{{{ Keyboard... +;; ;;{{{ Packages... +;; ;;{{{ Major modes... +;; ;;{{{ Minor modes... +;; ;;{{{ Debug... +;; +;; To enter a fold, use `C-c @ >'. To show it without entering, +;; use `C-c @ C-s', which produces this display: +;; +;; ;;{{{ Minor modes +;; +;; ;;{{{ Follow mode... +;; ;;{{{ Font-lock mode... +;; ;;{{{ Folding... +;; +;; ;;}}} +;; +;; To show everything, just as the file would look like if +;; Folding mode hadn't been activated, give the command `M-x' +;; `folding-open-buffer' `RET', normally bound to `C-c' `@' +;; `C-o'. To close all folds and go to the top level, the +;; command `folding-whole-buffer' could be used. +;; +;; Mouse support +;; +;; Folding mode v2.0 introduced mouse support. Folds can be shown +;; or hidden by simply clicking on a fold mark using mouse button +;; 3. The mouse routines have been designed to call the original +;; function bound to button 3 when the user didn't click on a +;; fold mark. +;; +;; The menu +;; +;; A menu is placed in the "Tools" menu. Should no Tools menu exist +;; (Emacs 19.28) the menu will be placed in the menu bar. +;; +;; ISearch +;; +;; When searching using the incremental search (C-s) facilities, +;; folds will be automagically entered and closed. +;; +;; Problems +;; +;; Uneven fold marks +;; +;; Oops, I just deleted some text, and a fold mark got deleted! +;; What should I do? Trust me, you will eventually do this +;; sometime. the easiest way is to open the buffer using +;; `folding-open-buffer' (C-c @ C-o) and add the fold mark by +;; hand. To find mismatching fold marks, the package `occur' is +;; useful. The command: +;; +;; M-x occur RET {{{\|}}} RET +;; +;; will extract all lines containing folding marks and present +;; them in a separate buffer. +;; +;; Even though all folding marks are correct, Folding mode +;; sometimes gets confused, especially when entering and leaving +;; folds very often. To get it back on track, press C-g a few +;; times and give the command `folding-open-buffer' (C-c @ C-o). +;; +;; Fold must have a label +;; +;; When you make a fold, be sure to write some text for the name +;; of the fold, otherwise there may be an error "extraneous fold +;; mark..." Write like this: +;; +;; ;;{{{ Note +;; ;;}}} +;; +;; instead of +;; +;; ;;{{{ +;; ;;}}} +;; +;; folding-whole-buffer doesn't fold whole buffer +;; +;; If you call commands `folding-open-buffer' and +;; `folding-whole-buffer' and notice that there are open fold +;; sections in the buffer, then you have mismatch of folds +;; somewhere. Run ` M-x' `occur' and type regexp `{{{\|}}}' to +;; check where is the extra open or closing fold mark. +;; +;; Folding and outline modes +;; +;; Folding mode is not the same as Outline mode, a major and +;; minor mode which is part of the Emacs distribution. The two +;; packages do, however, resemble each other very much. The main +;; differences between the two packages are: +;; +;; o Folding mode uses explicit marks, `{{{' and `}}}', to +;; mark the beginning and the end of a branch. +;; Outline, on the other other hand, tries to use already +;; existing marks, like the `\section' string in a TeX +;; document. +;; +;; o Outline mode has no end marker which means that it is +;; impossible for text to follow a sub-branch. +;; +;; o Folding mode use the same markers for branches on all depths, +;; Outline mode requires that marks should be longer the +;; further, down in the tree you go, e.g `\chap', \section', +;; `\subsection', `\subsubsection'. This is needed to +;; distinguish the next mark at the current or higher levels +;; from a sub-branch, a problem caused by the lack of +;; end-markers. +;; +;; o Folding mode has mouse support, you can navigate through a +;; folded document by clicking on fold marks. (The XEmacs version +;; of Outline mode has mouse support.) +;; +;; o The Isearch facilities of Folding is capable of +;; automatically to open folds. Under Outline, the the entire +;; document must be opened prior isearch. +;; +;; In conclusion, Outline mode is useful when the document being +;; edited contains natural markers, like LaTeX. When writing code +;; natural markers are hard to find, except if you're happy with +;; one function per fold. +;; +;; Future development ideas +;; +;; The plan was from the beginning to rewrite the entire package. +;; Including replacing the core of the program, written using +;; old Emacs technology (selective display), and replace it with +;; modern equivalences, like overlays or text-properties for +;; Emacs and extents for XEmacs. +;; +;; It is not likely that any of this will come true considering +;; the time required to rewrite the core of the package. Since +;; the package, in it's current state, is much more powerful than +;; the original, it would be appropriate to write such package +;; from scratch instead of doing surgery on this one. + +;;}}} + +;;{{{ Customization + +;; Customization: general +;; +;; The behavior of Folding mode is controlled mainly by a set of +;; Emacs Lisp variables. This section will discuss the most +;; useful ones, for more details please see the code. The +;; descriptions below assumes that you know a bit about how to +;; use simple Emacs Lisp and knows how to edit ~/.emacs, your +;; init file. +;; +;; Customization: hooks +;; +;; The normal procedure when customizing a package is to write a +;; function doing the customization. The function is then added +;; to a hook which is called at an appropriate time. (Please see +;; the example section below.) The following hooks are +;; available: +;; +;; o `folding-mode-hook' +;; Called when folding mode is activated. +;; o `-folding-hook' +;; Called when starting folding mode in a buffer with major +;; mode set to . (e.g. When editing C code +;; the hook `c-mode-folding-hook' is called.) +;; o `folding-load-hook' +;; Called when folding mode is loaded into Emacs. +;; +;; Customization: The Mouse +;; +;; The variable `folding-behave-table' contains the actions which +;; should be performed when the user clicks on an open fold, a +;; closed fold etc. For example, if you prefer to `enter' a fold +;; rather than `open' it you should rebind this variable. +;; +;; The variable `folding-default-mouse-keys-function' contains +;; the name of the function used to bind your mouse keys. To use +;; your own mouse bindings, create a function, say +;; `my-folding-bind-mouse', and set this variable to it. +;; +;; Customization: Keymaps +;; +;; When Emacs 19.29 was released, the keymap was divided into +;; strict parts. (This division existed before, but a lot of +;; packages, even the ones delivered with Emacs, ignored them.) +;; +;; C-c -- Reserved for the users private keymap. +;; C-c C- -- Major mode. (Some other keys are +;; reserved as well.) +;; C-c +;; -- Reserved for minor modes. +;; +;; The reason why `C-c@' was chosen as the default prefix is that +;; it is used by outline-minor-mode. It is not likely that few +;; people will try to use folding and outline at the same time. +;; +;; However, old key bindings have been kept if possible. The +;; variable `folding-default-keys-function' specifies which +;; function should be called to bind the keys. There are various +;; function to choose from how user can select the keybindings. +;; To use the old key bindings, add the following line to your +;; init file: +;; +;; (setq folding-default-keys-function +;; 'folding-bind-backward-compatible-keys) +;; +;; To define keys similar to the keys used by Outline mode, use: +;; +;; (setq folding-default-keys-function +;; 'folding-bind-outline-compatible-keys) +;; +;; Customization: adding new major modes +;; +;; To add fold marks for a new major mode, use the function +;; `folding-add-to-marks-list'. The command also replaces +;; existing marks. An example: +;; +;; (folding-add-to-marks-list +;; 'c-mode "/* {{{ " "/* }}} */" " */" t) +;; +;; Customization: ISearch +;; +;; If you don't like the extension folding.el applies to isearch, +;; set the variable `folding-isearch-install' to nil before +;; loading this package. + +;;}}} +;;{{{ Examples + +;; Example: personal setup +;; +;; To define your own key binding instead of using the standard +;; ones, you can do like this: +;; +;; (setq folding-mode-prefix-key "\C-c") +;; ;; +;; (setq folding-default-keys-function +;; '(folding-bind-backward-compatible-keys)) +;; ;; +;; (setq folding-load-hook 'my-folding-load-hook) +;; +;; +;; (defun my-folding-load-hook () +;; "Folding setup." +;; +;; (folding-install) ;; just to be sure +;; +;; ;; ............................................... markers ... +;; +;; ;; Change text-mode fold marks. Handy for quick +;; ;; sh/perl/awk code +;; +;; (defvar folding-mode-marks-alist nil) +;; +;; (let* ((ptr (assq 'text-mode folding-mode-marks-alist))) +;; (setcdr ptr (list "# {{{" "# }}}"))) +;; +;; ;; ........................................ bindings ... +;; +;; ;; Put `folding-whole-buffer' and `folding-open-buffer' +;; ;; close together. +;; +;; (defvar folding-mode-prefix-map nil) +;; +;; (define-key folding-mode-prefix-map "\C-w" nil) +;; (define-key folding-mode-prefix-map "\C-s" +;; 'folding-show-current-entry) +;; (define-key folding-mode-prefix-map "\C-p" +;; 'folding-whole-buffer)) +;; +;; Example: changing default fold marks +;; +;; In case you're not happy with the default folding marks, you +;; can change them easily. Here is an example +;; +;; (setq folding-load-hook 'my-folding-load-hook) +;; +;; (defun my-folding-load-hook () +;; "Folding vars setup." +;; ;; Change marks for 'text-mode' +;; (let* ((ptr (assq 'text-mode folding-mode-marks-alist))) +;; (setcdr ptr (list "# {{{" "# }}}")))) +;; +;; Example: choosing different fold marks for mode +;; +;; Suppose you sometimes want to use different fold marks for the +;; major mode: e.g. to alternate between "# {{{" and "{{{" in +;; `text-mode' Call `M-x' `my-folding-text-mode-setup' to change +;; the marks. +;; +;; (defun my-folding-text-mode-setup (&optional use-custom-folding-marks) +;; (interactive +;; (list (y-or-n-p "Use Custom fold marks now? "))) +;; (let* ((ptr (assq major-mode folding-mode-marks-alist)) +;; (default-begin "# {{{") +;; (default-end "# }}}") +;; (begin "{{{") +;; (end "}}}")) +;; (when (eq major-mode 'text-mode) +;; (unless use-custom-folding-marks +;; (setq begin default-begin end default-end))) +;; (setcdr ptr (list begin end)) +;; (folding-set-marks begin end))) +;; +;; Example: AucTex setup +;; +;; Suppose you're using comment.sty with AucTeX for editing +;; LaTeX2e documents and you have these comment types. You would +;; like to be able to set which of these 3 is to be folded at any +;; one time, using a simple key sequence: move back and forth +;; easily between the different comment types, e.g., "unfold +;; everything then fold on \x". +;; +;; \O ... \endO +;; \L ... \endL +;; \B ... \endB +;; +;; (setq folding-load-hook 'my-folding-load-hook) +;; +;; (defun my-folding-load-hook () +;; "Folding vars setup." +;; (let ((ptr (assq 'text-mode folding-mode-marks-alist))) +;; (setcdr ptr (list "\\O" "\\endO")) +;; (define-key folding-mode-prefix-map "C" +;; 'my-folding-marks-change))) +;; +;; (defun my-folding-marks-change (&optional selection) +;; "Select folding marks: prefixes nil, C-u and C-u C-u." +;; (interactive "P") +;; (let ((ptr (assq major-mode folding-mode-marks-alist)) +;; input) +;; (when (string-match "^\\(plain-\\|la\\|auc\\)?tex-" +;; (symbol-name major-mode)) +;; (setq input +;; (read-string "Latex \\end(X) Marker (default O): " +;; nil nil "O" nil)) +;; (setq input (upcase input)) +;; (turn-off-folding-mode) +;; (folding-add-to-marks-list +;; major-mode +;; (concat "\\" input) (concat "\\end" input) nil nil t) +;; ;; (setcdr ptr (list (concat "\\" input) (concat "\\end" input))) +;; (turn-on-folding-mode)))) +;; ;; End of example +;; +;; Bugs: Lazy-shot.el conflict in XEmacs +;; +;; [XEmacs 20.4 lazy-shot-mode] +;; 1998-05-28 Reported by Solofo Ramangalahy +;; +;; % xemacs -q folding.el +;; M-x eval-buffer +;; M-x folding-mode +;; M-x font-lock-mode +;; M-x lazy-shot-mode +;; C-s mouse +;; +;; then search for mouse again and again. At some point you will +;; see "Deleting extent" in the minibuffer and XEmacs freezes. +;; +;; The strange point is that I have this bug only under Solaris +;; 2.5 sparc (binaries from ftp.xemacs.org) but not under Solaris +;; 2.6 x86. (XEmacs 20.4, folding 2.35). I will try to access +;; more machines to see if it's the same. +;; +;; I suspect that the culprit is lazy-shot as it is beta, but +;; maybe you will be able to describe the bug more precisely to +;; the XEmacs people I you can reproduce it. + +;;}}} +;;{{{ Old Documentation + +;; Old documentation +;; +;; The following text was written by Jamie Lokier for the release +;; of Folding V1.6. It is included here for no particular reason: +;; +;; Emacs 18: +;; Folding mode has been tested with versions 18.55 and +;; 18.58 of Emacs. +;; +;; Epoch: +;; Folding mode has been tested on Epoch 4.0p2. +;; +;; [X]Emacs: +;; There is code in here to handle some aspects of XEmacs. +;; However, up to version 19.6, there appears to be no way to +;; display folds. Selective-display does not work, and neither do +;; invisible extents, so Folding mode has no chance of +;; working. This is likely to change in future versions of +;; XEmacs. +;; +;; Emacs 19: +;; Tested on version 19.8, appears to be fine. Minor bug: +;; display the buffer in several different frames, then move in +;; and out of folds in the buffer. The frames are automatically +;; moved to the top of the stacking order. +;; +;; Some of the code is quite horrible, generally in order to +;; avoid some Emacs display "features". Some of it is specific to +;; certain versions of Emacs. By the time Emacs 19 is around and +;; everyone is using it, hopefully most of it won't be necessary. +;; +;; More known bugs +;; +;; *** Needs folding-fold-region to be more intelligent about +;; finding a good region. Check folding a whole current fold. +;; +;; *** Now works with 19! But check out what happens when you +;; exit a fold with the file displayed in two frames. Both +;; windows get fronted. Better fix that sometime. +;; +;; Future features +;; +;; *** I will add a `folding-next-error' sometime. It will only +;; work with Emacs versions later than 18.58, because compile.el +;; in earlier versions does not count line-numbers in the right +;; way, when selective display is active. +;; +;; *** Fold titles should be optionally allowed on the closing +;; fold marks, and `folding-tidy-inside' should check that the +;; opening title matches the closing title. +;; +;; *** `folded-file' set in the local variables at the end of a +;; file could encode the type of fold marks used in that file, +;; and other things, like the margins inside folds. +;; +;; *** I can see a lot of use for the newer features of Emacs 19: +;; +;; Using invisible text-properties (I hope they are intended to +;; make text invisible; it isn't implemented like that yet), it +;; will be possible to hide folded text without affecting the +;; text of the buffer. At the moment, Folding mode uses selective +;; display to hide text, which involves substituting +;; carriage-returns for line-feeds in the buffer. This isn't such +;; a good way. It may also be possible to display different folds +;; in different windows in Emacs 19. +;; +;; Using even more text-properties, it may be possible to track +;; pointer movements in and out of folds, and have Folding mode +;; automatically enter or exit folds as necessary to maintain a +;; sensible display. Because the text itself is not modified (if +;; overlays are used to hide text), this is quite safe. It would +;; make it unnecessary to provide functions like +;; `folding-forward-char', `folding-goto-line' or +;; `folding-next-error', and things like I-search would +;; automatically move in and out of folds as necessary. +;; +;; Yet more text-properties/overlays might make it possible to +;; avoid using narrowing. This might allow some major modes to +;; indent text properly, e.g., C++ mode. + +;;}}} + +;;; Change Log: + +;;{{{ History + +;; [person version] = developer and his revision tree number. +;; NOTE: History records were stopped in 2009 when code was moved under +;; version control. See VCS logs. +;; +;; Sep 20 2009 23.1 [jari git a80c2d6] +;; - Remove 'defmacro custom' for very old Emacs version that did +;; not have custom. +;; - Modernize all macros to use new backquote syntax, +;; - Move `folding-narrow-by-default' variable +;; definition before `folding-advice-instantiate' which +;; refers to it. +;; +;; Feb 20 2009 22.2.1 [jari git 51ada03..56b3089] +;; - Make XEmacs CVS and Savannah git revisions at header more clear +;; - Unify html-mode folds as in other modes: change [[[ ]]] to {{{ }}} +;; +;; Feb 09 2009 22.2.1 [jari git e0c2e92..6a3cff7] +;; - Minor documentaton fixes. +;; - Add new `python-mode' using `folding-add-to-marks-list'. +;; - Add new variable `folding-version-time' to record edit time. +;; Value is automatically updated by developer's Emacs setup. +;; +;; May 06 2007 21.4 [jari 3.38-3.41 2007.0506] +;; - Cleanup. Eol whitespaces removed, extra newlines cleaned. +;; Paren positions corrected. +;; - 'Personal reflections by Anders Lindgren' topic +;; rephrased 'Future development ideas' +;; - (folding-show-current-entry): Run `font-lock-fontify-region' +;; after opening the fold. Font-lock.el treated all closed folds +;; as comments. +;; +;; Nov 16 2006 21.4 [jari 3.36-3.37 2006.1118] +;; - Jeremy Hankins sent a patch, which +;; adds variable `folding-narrow-by-default'. The patch affects +;; mostly `folding-shift-in'. This makes it possible to +;; advise viper-search to open folds. Thanks. +;; - Added VCS URL header to the beginning for canonnical location. +;; Updated maintainer section. +;; - Fixed Copyright years. +;; +;; Nov 25 2004 21.3 [jari 3.35 2004.1125] +;; - non-ascii character removed from bibtex-mode. +;; Changed bib-mode '@comment' => '%'. Closes Debian +;; Bug#282388 +;; +;; Sep 10 2004 21.3 [jari 2.116 2004.0910] +;; - (folding-fold-region): caused to indent bottom fold +;; some 50 spaces forward in auctex:latex-mode. Disabled +;; running `indent-according-to-mode' while in latex-mode. +;; Bug reported by Uwe Brauer; oub A T mat dot ucm dot es +;; - Removed extra newlines from whole buffer. +;; - Changed version scheme to date based YYYY.MMDD +;; - Removed unnecessary 'all rights reserved'. +;; - (folding-check-folded): Added check for \r character, which +;; - protected all email addresses by removing AT-signs. +;; +;; Apr 01 2004 21.3 [jari 2.111-2.115] +;; - Merged in changes made by 2003-11-12 Adrian Aichner +;; from XEmacs tree 1.15; Typo fixes for docstrings and comments. +;; - Returned to old bug and solved it in a better way (preserve region) by +;; using different expansion macros for XEmacs and Emacs. +;; See See http://list-archive.xemacs.org/xemacs-beta/199810/msg00039.html +;; - (folding-forward-char-1): 2.112 Renamed. +;; Was `folding-forward-char'. +;; (folding-backward-char-1): 2.112 Renamed. +;; Was `folding-backward-char'. +;; (folding-forward-char-macro): 2.112 New. Fix XEmacs +;; region preservation with '_p' interactive spec. +;; (folding-backward-char-macro): 2.112 New. Fix XEmacs +;; region preservation with '_p' interactive spec. +;; (folding-interactive-spec-p): 2.112 New. +;; +;; Sep 11 2003 21.2 [jari 2.107-2.111] +;; - Added new sections "Uninstallation" and "To read the manual". +;; M-x finder can invoke folding too provided that patch to +;; lisp-mnt.el and finder.el is installed. Sent patch to XEmacs and +;; Emacs developers. +;; - Moved fold-mark ";;{{{ Introduction" after the Commentary: +;; tag to have it included in M-x finder-commentary. +;; - If called like this: `folding-uninstall' and immediately +;; `folding-mode', the keybindings were not there any more. Added +;; call to `folding-install' in `folding-mode'. +;; - Completely rewrote `folding-install'. It's now divided into +;; `folding-install-keymaps' and `folding-uninstall-keymaps' +;; - Added support for `php-mode', `javascript-mode', +;; `change-log-mode' and `finder-mode'. +;; - Documentation changes (fit all to 80 characters). +;; +;; Aug 21 2002 21.2 [jari 2.105-2.106] +;; - Added user function `folding-uninstall'. +;; - Removed `interactive' status: `folding-install-hooks' and +;; `folding-uninstall-hooks' +;; +;; Aug 02 2002 20.7 [jari 2.101-2.104] +;; - Added font lock support. Now beginning and end markers are +;; highlighted with user variables `folding-font-lock-begin-mark' +;; `folding-font-lock-end-mark'. Feature suggested by +;; +;; - Removed LCD entry - unnecessary. +;; +;; Jan 24 2002 20.7 [jari 2.100] +;; - (folding-context-next-action):New user function. +;; Code by Scott Evans +;; - (folding-bind-default-keys): Added +;; C-x . to run `folding-context-next-action' +;; - (folding-mouse-call-original): Added `car-safe' to read +;; EVENT, which may be nil. +;; +;; Jul 31 2001 20.7 [jari 2.98-2.99] +;; - Gleb Arshinov fixed the broken XEmacs +;; isearch support and sent nice patch. +;; +;; Jul 19 2001 20.7 [jari 2.92-2.97] +;; - Beautified lisp code by removing parens that were alone. +;; - XEmacs latex-mode fix. The folds were strangely indented too +;; far right. The cause was `indent-according-to-mode' which is +;; now disabled in latex. bug reported by +;; Uwe Brauer; oub A T maraton sim ucm es +;; - 2.96 Erroneous `:' in `folding-mode-write-file' +;; when it should have been `;'. Bug reported by +;; Brand Michael; michael brand A T siemens com +;; +;; Apr 04 2001 20.7 [jari 2.89-2.91] +;; - Small corrections to find-func.el::find-function-search-for-symbol +;; implementation. +;; +;; Mar 08 2001 20.6 [jari 2.88] +;; - Dave Masterson reported that jumping to a +;; url displayed by the C-h f FUNCTION which told where the function +;; was located died. The reason was that the buffer was folded and +;; find-func.el::find-function-search-for-symbol used regexps that +;; do not take into account folded buffers. The regexps used there +;; rely on syntax tables. +;; - Added two new advices to catch find-func.el and unfold the buffer +;; prior searching: (advice find-file-noselect after) and (advice +;; find-function-search-for-symbol around) +;; +;; Mar 04 2001 20.6 [jari 2.83-2.87] +;; - Added ###autoload statements, tidied up empty lines and lisp syntax. +;; - Run checkdoc.el 0.6.1 and corrected errors. +;; +;; Jan 04 2001 20.6 [jari 2.82] +;; - Added FOLD highlight feature for XEmacs: +;; `folding-mode-motion-highlight-fold' +;; and package `mode-motion' Suggested by +;; Thomas Ruhnau +;; - (folding-bind-default-keys): 2.81 New binding C-k +;; `folding-marks-kill' +;; (fold-marks-kill): 2.81 New. +;; +;; Jan 03 2001 20.6 [jari 2.81] +;; - (folding-folding-region): 2.80 Renamed to `folding-fold-region' +;; - (folding-mark-look-at-top-mark-p): 2.80 New. +;; - (folding-mark-look-at-bottom-mark-p): 2.80 New. +;; - (folding-tidy-inside): 2.80 Use `folding-mark-look-at-top-mark-p' +;; and `folding-mark-look-at-bottom-mark-p'. +;; - Didn't accept spaces in front of fold markers. +;; - (folding-fold-region): 2.80 Added `indent-according-to-mode' +;; to indent folds as needed. +;; +;; Dec 16 2000 20.6 [jari 2.79-2.80] +;; - `folding-xemacs-p' now test (featurep 'xemacs) +;; - Added missing folding functions to the menubar +;; - `folding-package-url-location' new variable used by function +;; `folding-insert-advertise-folding-mode' +;; - `folding-keep-hooked' was commented out in `folding-mode'. Added +;; back. +;; +;; Jul 25 2000 20.6 [jari 2.76-2.78] +;; - 2.75 Added support for modes: +;; xrdb-mode, ksh-mode and sql-mode contributed by +;; Juhapekka Tolvanen . Scanned systematically +;; all modes under Emacs 20.6 progmodes and added support for: +;; ada-mode, asm-mode, awk-mode, cperl-mode, fortran-mode, f90-mode, +;; icon-mode, m4-mode, meta-mode, pascal-mode, prolog-mode, +;; simula-mode, vhdl-mode, bibtex-mode, nroff-mode, scribe-mode(*), +;; sgml-mode +;; - Mode marked with (*) was not added. +;; - (folding-insert-advertise-folding-mode): 2.76 New. Suggested by +;; Juhapekka Tolvanen +;; - (folding-bind-default-keys): 2.76 +;; folding-insert-advertise-folding-mode Bound to key "I" +;; +;; Apr 24 1999 20.4 [jari 2.73-2.75] +;; - (folding-bind-terminal-keys): 2.74 New. Bind C-f and C-b only at +;; non-window system where they are really needed. Someone may use +;; C-f for `isearch-forward' in windowed Emacs. +;; - (folding-bind-default-keys): 2.74 Use `folding-bind-terminal-keys' +;; - (folding-bind-outline-compatible-keys): 2.74 +;; Use `folding-bind-terminal-keys' +;; +;; Feb 13 1999 20.4 [jari 2.71-2.72] +;; - (folding-event-posn): 2.70 Wrong +;; place of paren and the following was malformed call: +;; (let* ((el (funcall (symbol-function 'event-start) event))) +;; +;; Jan 13 1999 20.4 [jari 2.70] +;; - 2.69 The `looking-at' is now smarter with +;; fold beginning marks. The tradition has been the the fold always +;; has a name, so the requirement to search fold is "{{{ ". Now +;; the " " is searched as " *", not requiring a space --> not requiring +;; a fold name. +;; - (folding-skip-folds): >>feature not not enabled<< +;; 2.69 Do not require trailing " " any more.' +;; (folding-tidy-inside): >>feature not not enabled<< +;; 2.69 Do not require trailing " " any more. +;; - (folding-install): 2.69 Fixed indentation. +;; - (folding-mark-look-at): 2.69 The "em" missed "*" and thus pressing +;; mouse-3 at the end-fold didn't collapse the whole fold. +;; +;; Jan 12 1999 20.4 [jari 2.69] +;; (folding-bind-default-mouse): 2.68 +;; XEmacs and Emacs Mouse binding was different. Now use common +;; bindings: The S-mouse-2 was superfluous, because mouse-3 already +;; did that, so the binding was removed. +;; mouse-3 folding-mouse-context-sensitive +;; S-mouse-2 folding-hide-current-entry +;; C-S-mouse-2 folding-mouse-pick-move +;; +;;;; Jan 09 1999 20.4 [jari 2.67-2.68] +;; - (folding-event-posn): 2.66 Hide `event-start' From XEmacs +;; (byte compile silencer) +;; +;; Jan 07 1999 20.4 [jari 2.65-2.66] +;; - The Folding begin and AND mark was not case sensitive; +;; that's why a latex styles "\B" and "\endB" fold marks couldn't +;; be used. Added relevant `case-fold-search' settings. Not tested +;; very well, though. +;; - Added standard "turn-on" "turn-off" functions. +;; - (folding-whole-buffer): 2.65 Better +;; Error message. Show used folding-mark on error. +;; - (folding-skip-folds): 2.65 Moved docs in function. +;; - (turn-off-folding-mode): 2.65 New. +;; - (turn-on-folding-mode): 2.65 New. +;; - (folding-mark-look-at): 2.65 `case-fold-search' +;; - (folding-next-visible-heading): 2.65 `case-fold-search' +;; - (folding-find-folding-mark): 2.65 `case-fold-search' +;; - (folding-pick-move): 2.65 `case-fold-search' +;; - (folding-skip-folds): 2.65 `case-fold-search' +;; - (folding-tidy-inside): 2.65 `case-fold-search' +;; - (folding-convert-to-major-folds): 2.65 `case-fold-search' +;; +;; Jan 04 1999 20.4 [jari 2.62-2.64] +;; - (folding-set-local-variables): 2.61 New. Now it is possible to +;; change the folding marks dynamically. +;; - (folding-mode): 2.61 Call `folding-set-local-variables' +;; (folding-mode-marks-alist): 2.61 mention +;; - `folding-set-local-variables' +;; Added documentation section: "Example: AucTex setup" +;; - NT Emacs fix wrapped inside `eval-and-compile'. hs-discard-overlays +;; are now hidden from byte compiler (since the code is not +;; executed anyway) +;; +;; May 24 1999 19.34 [jari 2.59-2.61] +;; - New function `folding-all-comment-blocks-in-region'. Requested by +;; Uwe Brauer . Bound under "/" key. +;; - (folding-all-comment-blocks-in-region): +;; Check non-whitespace `comment-end'. Added `matlab-mode' to +;; fold list +;; - (folding-event-posn): 2.63 Got rid of the XEmacs/Emacs +;; posn-/event- byte compiler warnings +;; - (folding-mouse-call-original): 2.63 Got rid of the XEmacs +;; `event-button' byte compiler warning. +;; +;; Apr 15 1999 19.34 [jari 2.57] +;; - (folding-mouse-call-original): Samuel Mikes +;; reported that the `concat' function was +;; used to add an integer to "button" event. Applied patch to use +;; `format' instead. +;; +;; Mar 03 1999 19.34 [andersl] +;; - (folding-install): had extra paren. Removed. +;; +;; Feb 22 1999 19.34 [jari 2.56] +;; - folding-install): +;; Check if `folding-mode-prefix-map' is nil and call +;; +;; Feb 19 1999 19.34 [jari 2.55] +;; - (folding-mode-hook-no-re): +;; Renamed to `folding-mode-hook-no-regexp' +;; - (fold-inside-mode-name): Renames to `folding-inside-mode-name' +;; (fold-mode-string): Renamed to `folding-mode-string' +;; - Renamed all `fold-' prefixes to `folding-' +;; - Rewrote chapter `Example: personal setup' +;; +;; Jan 01 1999 19.34 [jari 2.54] +;; - Byte compiler error fix: (folding-bind-outline-compatible-keys): +;; 'folding-show-all lacked the quote. +;; +;; Dec 30 1998 19.34 [jari 2.53] +;; - Jesper Pedersen reported bug that hiding +;; subtree was broken. This turned out to be a bigger problem in fold +;; handling in general. This release has big relatively big error +;; fixes. +;; - Many of the folding functions were also renamed to mimic Emacs 20.3 +;; allout.el names. Outline keybindings were rewritten too. +;; - folding.el (folding-mouse-yank-at-point): Renamed from +;; `folding-mouse-operate-at-point'. The name is similar to Emacs +;; standard variable name. The default value changed from nil --> t +;; according to suggestion by Jesper Pedersen +;; Message "Info, Ignore [X]Emacs specific..." is now displayed only +;; while byte compiling file. +;; (folding-bind-outline-compatible-keys): +;; Checked the Emacs 20.3 allout.el outline bindings and made +;; folding mimic them +;; (folding-show-subtree): Renamed to `folding-show-current-subtree' +;; according to allout.el +;; (folding-hide-subtree): Renamed to `folding-hide-current-subtree' +;; according to allout.el +;; (folding-enter): Renamed to `folding-shift-in' +;; according to allout.el +;; (folding-exit): Renamed to `folding-shift-out' +;; according to allout.el +;; (folding-move-up): Renamed to `folding-previous-visible-heading' +;; according to allout.el +;; (folding-move): Renamed to `folding-next-visible-heading' +;; according to allout.el +;; (folding-top-level): Renamed to `folding-show-all' +;; according to allout.el +;; (folding-show): Renamed to `folding-show-current-entry' +;; according to allout.el +;; (folding-hide): Renamed to `folding-hide-current-entry' +;; according to allout.el +;; (folding-region-open-close): While loop rewritten so that if user +;; is already on a fold mark, then close current fold. This also +;; fixed the show/hide subtree problem. +;; (folding-hide-current-subtree): If use hide subtree that only had +;; one fold, then calling this function caused error. The reason was +;; error in `folding-pick-move' (folding-pick-move): Test that +;; `moved' variable is integer and only then move point. This is the +;; status indicator from `folding-find-folding-mark' +;; (folding-find-folding-mark): Fixed. mistakenly moved point when +;; checking TOP level marker, status 11. the point was permanently +;; moved to point-min. +;; +;; Dec 29 1998 19.34 [jari 2.51] +;; - Jesper Pedersen reported that prefix key +;; cannot take vector notation [(key)]. This required changing the way +;; how folding maps the keys. Now uses intermediate keymap +;; `folding-mode-prefix-map' +;; - `folding-kbd' is new. +;; - `folding-mode' function description has better layout. +;; - `folding-get-mode-marks' is now defsubst. +;; +;; Dec 13 1998 19.34 [jari 2.49-2.50] +;; - Gleb Arshinov reported that the XEmacs 21.0 +;; `concat' function won't accept integer argument any more and +;; provided patch for `folding-set-mode-line'. +;; +;; Nov 28 1998 19.34 [jari 2.49-2.50] +;; - Gleb Arshinov reported that the +;; zmacs-region-stays must not be set globally but in the functions +;; that need it. He tested the change on tested on XEmacs 21.0 beta +;; and FSF Emacs 19.34.6 on NT and sent a patch . Thank you. +;; - (folding-preserve-active-region): New macro to set +;; `zmacs-region-stays' to t in XEmacs. +;; - (folding-forward-char): Use `folding-preserve-active-region' +;; - (folding-backward-char): Use `folding-preserve-active-region' +;; - (folding-end-of-line): Use `folding-preserve-active-region' +;; - (folding-isearch-general): Variables `is-fold' and +;; `is narrowed' removed, because they were not used. (Byte +;; Compilation fix) +;; - Later: interestingly using `defmacro' +;; folding-preserve-active-region does not work in XEmacs 21.0 beta, +;; but `defsubst' does. Reported and corrected by Gleb. +;; +;; Oct 22 1998 19.34 [jari 2.47-2.48] +;; - NT Emacs has had long time a bug where it strips away ^M when +;; closed fold is copied to kill ring. When pasted, then ^M are +;; gone. This cover NT Emacs releases 19.34 - 20.3. Bug report has +;; been filed. +;; - to cope with the situation I added new advice functions that +;; get instantiated only for these versions of NT Emacs. See +;; `kill-new' and `current-kill' +;; +;; Oct 21 1998 19.34 [jari 2.46] +;; - `folding-isearch-general' now enters folds as usual with isearch. +;; The only test needed was to check `quit-isearch' before calling +;; `folding-goto-char', because the narrow case was already taken +;; cared of in the condition case. +;; +;; Oct 19 1998 19.34 [jari 2.44] +;; - 1998-10-19 Uwe Brauer reported that +;; In Netscape version > 4 the {{{ marks cannot be used. For IE they +;; were fine, but not for Netscape. Some bug there. +;; --> Marks changed to [[[ ]]] +;; +;; Oct 5 1998 19.34 [jari 2.43] +;; - The "_p" flag does not exist in Emacs 19.34, so the previous patch +;; was removed. (Greg Klanderman) suggested using +;; `zmacs-region-stays'. Added to the beginning of file. +;; - todo: folding does not seem to open folds any more with Isearch. +;; +;; Oct 5 1998 19.34 [jari 2.42] +;; - Gleb Arshinov reported (and supplied patch): +;; I am using the latest beta of folding.el with XEmacs 21.0 "Finnish +;; Landrace" [Lucid] (i386-pc-win32) (same bug is present with folding.el +;; included with XEmacs). Being a big fan of zmacs-region, I was +;; disappointed to find that folding mode caused my usual way of +;; selecting regions (e.g. to select a line C-space, C-a, C-e) to break +;; :( I discovered that the following 3 functions would unset my mark. +;; Upon reading some documentation, this seems to be caused by an +;; argument to interactive used by these functions. With the following +;; tiny patch, the undesirable behaviour is gone. +;; - Patch was applied as is. Function affected: +;; `folding-forward-char' `folding-backward-char' +;; `folding-end-of-line'. Interactive spec changed from "p" to "_p" +;; +;; Sep 28 1998 19.34 [jari 2.41] +;; - Wrote section "folding-whole-buffer doesn't fold whole buffer" to +;; Problems topic. Fixed some indentation in documentation so that +;; command ripdoc.pl folding.el | t2html.pl --simple > folding.html +;; works properly. +;; +;; Sep 24 1998 19.34 [jari 2.40] +;; - Stephen Smith wished that the +;; `folding-comment-fold' should handle modes that have comment-start +;; and comment-end too. That lead to rewriting the comment function so +;; that it can be adapted to new modes. +;; - `folding-pick-move' didn't work in C-mode. Fixed. +;; (folding-find-folding-mark): +;; m and re must be protected with `regexp-quote'. This +;; corrected error eg. in C-mode where `folding-pick-move' +;; didn't move at all. +;; (folding-comment-fold): Added support for major modes that +;; have `comment-start' and `comment-end'. Use +;; `folding-comment-folding-table' +;; (folding-comment-c-mode): New. +;; (folding-uncomment-c-mode): New. +;; (folding-comment-folding-table): New. To adapt to any major-mode. +;; (folding-uncomment-mode-generic): New. +;; (folding-comment-mode-generic): New. +;; +;; Aug 08 1998 19.34 [jari 2.39] +;; - Andrew Maccormack reported that the +;; `em' end marker that was defined in the `let' should also have +;; `[ \t\n]' which is in par with the `bm'. This way fold markers do +;; not need to be parked to the left any more. +;; +;; Jun 05 1998 19.34 [jari 2.37-2.38] +;; - Alf-Ivar Holm send functions +;; `folding-toggle-enter-exit' and `folding-toggle-show-hide' which +;; were integrated. Alf also suggested that Fold marks should now +;; necessarily be located at the beginning of line, but allow spaces +;; at front. The patch was applied to `folding-mark-look-at' +;; +;; Mar 17 1998 19.34 [Anders] +;; - Anders: This patch fixes one problem that was reported in the +;; beginning of May by Ryszard Kubiak . +;; - Finally, I think that I have gotten mouse-context-sensitive +;; right. Now, when you click on a fold that fold rather than the +;; one the cursor is on is used, while still not breaking commands +;; like `mouse-save-then-kill' which assumes that the point hasn't +;; been moved. +;; - Jari: Added topic "Fold must have a label" to the Problem section. +;; as reported by Solofo Ramangalahy +;; - 1998-05-04 Ryszard Kubiak reported: I am +;; just curious if it is possible to make Emacs' cursor +;; automatically follow a mouse-click on the {{{ and }}} lines. I +;; mean by this that a [S-mouse-3] (as defined in my settings below +;; --- I keep not liking overloading [mouse-3]) first moves the +;; cursor to where the click happened and then hides or shows a +;; folded area. I presume that i can write a two-lines long +;; interactive function to do this. Still, may be this kind of mouse +;; behaviour is already available. +;; +;; Mar 17 1998 19.34 [Jari 2.34-2.35] +;; - Added "Example: choosing different fold marks for mode" +;; - corrected `my-folding-text-mode-setup' example. +;; +;; Mar 10 1998 19.34 [Jari 2.32-2.33] +;; - [Anders] responds to mouse-3 handling problem: I have found the +;; cause of the problem, and I have a suggestion for a fix. +;; +;; The problem is caused by two things: +;; * The "mouse-save-then-kill" checks that the previous command also +;; was "mouse-save-then-kill". +;; +;; * The second (more severe) problem is that +;; "folding-mouse-context-sensitive" sets the point to the +;; location of the click, effectively making +;; "mouse-save-then-kill" mark the area between the point and the +;; point! (This is why no region appears.) +;; +;; The first problem can be easily fixed by setting "this-command" +;; in "folding-mouse-call-original": +;; +;; - Now the good old mouse-3 binding is back again. +;; - (folding-mouse-context-sensitive): Added `save-excursion' as +;; Anders suggested before setting `state'. +;; (folding-mouse-call-original): commented out experimental code and +;; used (setq this-command orig-func) as Anders suggested. +;; +;; Mar 10 1998 19.34 [Jari 2.31] +;; - (folding-act): Added `event' to `folding-behave-table' calls. +;; Input argument takes now `event' too +;; - (folding-mouse-context-sensitive): Added argument `event' +;; - (folding-mouse-call-original): Added (this-command orig-func) +;; when calling original command. +;; - (folding-bind-default-mouse): Changed mouse bindings. The +;; button-3 can't be mapped by folding, because folding is unable to +;; call the original function `mouse-save-then-kill'. Passing simple +;; element to `mouse-save-then-kill' won't do the job. Eg if I +;; (clicked mouse-1) moved mouse pointer to place X and pressed +;; mouse-3, the area was not highlighted in folding mode. If folding +;; mode was off the are was highlighted. I traced the +;; `folding-mouse-call-original' and it was passing exactly the same +;; event as without folding mode. I have no clue what to do about +;; it...That's why I removed default mouse-3 binding and left it to +;; emacs. This bug was reported by Ryszard Kubiak" +;; +;; +;; Feb 12 1998 19.34 [Jari 2.30] +;; - (html-mode): New mode added to `folding-mode-marks-alist' +;; - (folding-get-mode-marks): Rewritten, now return 3rd element too. +;; - (folding-comment-fold): Added note that function with `comment-end' +;; is not supported. Function will flag error in those cases. +;; - (folding-convert-to-major-folds): Conversion failed if eg; you +;; switched between modes that has 2 and 1 comments, like +;; /* */ (C) and //(C++). Now the conversion is bit smarter, but it's +;; impossible to convert from /* */ to // directly because we don't +;; know how to remove */ mark, you see: +;; +;; Original mode was C +;; +;; /* {{{ */ +;; +;; And now used changed it to C++ mode, and ran command +;; `folding-convert-to-major-folds'. We no longer have information +;; about old mode's beginning or end comment markers, so we only +;; can convert the folds to format +;; +;; // {{{ */ +;; +;; Where the ending comment mark from old mode is left there. +;; This is slightly imperfect situation, but at least the fold +;; conversion works. +;; +;; Jan 28 1998 19.34 [Jari 2.25-2.29] +;; - Added `generic-mode' to fold list, suggested by Wayne Adams +;; +;; - Finally rewrote the awesome menu-bar code: now uses standard +;; easy-menu Which works in both XEmacs and Emacs. The menu is no +;; longer under "Tools", but appear when minor mode is turned on. +;; - Radical changes: Decided to remove all old lucid and epoch +;; dependencies. Lot of code removed and reprogrammed. +;; - I also got rid of the `folding-has-minor-mode-map-alist-p' variable +;; and old 18.xx function `folding-merge-keymaps'. +;; - Symbol's value as variable is void ((folding-xemacs-p)) error fixed. +;; - Optimized 60 `folding-use-overlays-p' calls to only 4 within +;; `folding-subst-regions'. (Used elp.el). It seems that half of the +;; time is spent in the function `folding-narrow-to-region' +;; function. Could it be optimized somehow? +;; - Changed "lucid" tests to `folding-xemacs-p' variable tests. +;; - Removed `folding-hack' and print message 'Info, ignore missing +;; functions.." instead. It's better that we see the missing +;; functions and not define dummy hacks for them. +;; +;; Nov 13 1997 19.34 [Jari 2.18-2.24] +;; - Added tcl-mode fold marks, suggested by Petteri Kettunen +;; +;; - Removed some old code and modified the hook functions a bit. +;; - Added new user function `folding-convert-to-major-folds', key "%". +;; - Added missing items to Emacs menubar, didn't dare to touch the +;; XEmacs part. +;; - `folding-comment-fold': Small fix. commenting didn't work on +;; closed folds. or if point was on topmost fold. +;; - Added `folding-advice-instantiate' And corrected byte compiler +;; message: Warning: variable oldposn bound but not referenced +;; Warning: reference to free variable folding-stack +;; - updated (require 'custom) code +;; +;; Nov 6 1997 19.34 [Jari 2.17] +;; - Uwe Brauer used folding for Latex files +;; and he wished a feature that would allow him to comment away ext +;; that was inside fold; when compiling the TeX file. +;; - Added new user function `folding-comment-fold'. And new +;; keybinding ";". +;; +;; Oct 8 1997 19.34 [Jari 2.16] +;; - Now the minor mode map is always re-installed when this file is +;; loaded. If user accidentally made mistake in +;; `folding-default-keys-function', he can simply try again and +;; reload this file to have the new key definitions. +;; - Previously user had to manually go and delete the previous map +;; from the `minor-mode-map-alist' before he could try again. +;; +;; Sep 29 1997 19.34 [Jari 2.14-2.15] +;; - Robert Marshall Sent enhancement to goto-line +;; code. Now M-g works more intuitively. +;; - Reformatted totally the documentation so that it can be ripped to +;; html with jari's ema-doc.pls and t2html.pls Perl scripts. +;; - Run through checkdoc.el 1.55 and Elint 1.10 and corrected code. +;; - Added defcustom support. (not tested) +;; +;; Sep 19 1997 19.28 [Jari 2.13] +;; - Robert Marshall Sent small correction to +;; overlay code, where the 'owner tag was set wrong. +;; +;; Aug 14 1997 19.28 [Jari 2.12 ] +;; - A small regexp bug (extra whitespace was required after closing +;; fold) cause failing of folding-convert-buffer-for-printing in the +;; following situation +;; - Reported by Guide. Fixed now. +;; +;; {{{ Main topic +;; {{{ Subsection +;; }}} << no space or end tag here! +;; }}} Main topic +;; +;; Aug 14 1997 19.28 [Jari 2.11] +;; - Guide Van Hoecke reported that +;; he was using closing text for fold like: +;; +;; {{{ Main topic +;; {{{ Subsection +;; }}} Subsection +;; }}} Main topic +;; +;; And when he did folding-convert-buffer-for-printing, it couldn't +;; remove those closing marks but threw an error. I modified the +;; function so that the regexp accepts anything after closing fold. +;; +;; Apr 18 1997 19.28 [Jari 2.10] +;; - Corrected function folding-show-current-subtree, which didn't +;; find the correct end region, because folding-pick-move needed +;; point at the top of beginning fold. Bug was reported by Uwe +;; Brauer Also changed folding-mark-look-at, +;; which now has new call parameter 'move. +;; +;; Mar 22 1997 19.28 [Jari 2.9] +;; - Made the XEmacs20 match more stricter, so that +;; folding-emacs-version gets value 'XEmacs19. Also added note about +;; folding in WinNT in the compatibility section. +;; - Added sh-script-mode indented-text-mode folding marks. +;; - Moved the version from branch to the root, because the extra +;; overlay code added, seems to be behaving well and it didn't break +;; the existing functionality. +;; +;; Feb 17 1997 19.28 [Jari 2.8.1.2] +;; - Cleaned up Dan's changes. First: we must not replace the +;; selective display code, but offer these two choices: Added +;; folding-use-overlays-p function which looks variable +;; folding-allow-overlays. +;; - Dan uses function from another Emacs specific (19.34+?) package +;; hs-discard-overlays. This is not available in 19.28. it should +;; be replaced with some new function... I didn't do that yet. +;; - The overlays don't exist in XEmacs. XE19.15 has promises: at least +;; I have heard that they have overlay.el library to mimic Emacs +;; functions. +;; - Now the overlay support can be turned on by setting +;; folding-allow-overlays to non-nil. The default is to use selective +;; display. Overlay Code is not tested! +;; +;; Feb 17 1997 19.28 [Dan 2.8.1.1] +;; - Dan Nicolaescu sent patch that replaced +;; selective display code with overlays. +;; +;; Feb 10 1997 19.28 [jari 2.8] +;; - Ricardo Marek Kindly sent patch that +;; makes code XEmacs 20.0 compatible. Thank you. +;; +;; Nov 7 1996 19.28 [jari 2.7] +;; - When I was on picture-mode and turned on folding, and started +;; isearch (I don't remember how I got fold mode on exactly) it +;; gave error that the fold marks were not defined and emacs +;; locked up due to simultaneous isearch-loop +;; - Added few fixes to the isearch handling function to avoid +;; infinite error loops. +;; +;; Nov 6 1996 19.28 [jari 2.5 - 2.6] +;; - Situation: have folded buffer, manually _narrow_ somewhere, C-x n n +;; - Then try searching --> folding breaks. Now it checks if the +;; region is true narrow and not folding-narrow before trying +;; to go outside of region and open a fold +;; - If it's true narrow, then we stay in that narrowed region. +;; +;; folding-isearch-general :+ +;; folding-region-has-folding-marks-p :+ +;; +;; Oct 23 1996 19.28 [jari 2.4] +;; folding-display-name :+ new user cmd "C-n" +;; folding-find-folding-mark :+ new +;; folding-pick-move :! rewritten, full of bugs +;; folding-region-open-close :! rewritten, full of bugs +;; +;; Oct 22 1996 19.28 [jari 2.3] +;; - folding-pick-move :! rewritten +;; folding-region-open-close :+ new user cmd "#" +;; folding-show-current-subtree :+ new user cmd "C-s", hides too +;; +;; Aug 01 1996 19.31 [andersl] +;; - folding-subst-regions, variable `font-lock-mode' set to nil. +;; Thanks to +;; +;; Jun 19 1996 19.31 [andersl] +;; - The code has proven itself stable through the beta testing phase +;; which has lasted the past six months. +;; - A lot of comments written. +;; - The package `folding-isearch' integrated. +;; - Some code cleanup: +;; BOLP -> folding-BOL :! renamed +;; folding-behave-table :! field `down' removed. +;; +;; +;; Mar 14 1996 19.28 [jari 1.27] +;; - No code changes. Only some textual corrections/additions. +;; - Section "about keymaps" added. +;; +;; Mar 14 1996 19.28 [jackr 1.26] +;; - spell-check run over code. +;; +;; Mar 14 1996 19.28 [davidm 1.25] +;; - David Masterson This patch makes the menubar in +;; XEmacs work better. After I made this patch, the Hyperbole menus +;; starting working as expected again. I believe the use of +;; set-buffer-menubar has a problem, so the recommendation in XEmacs +;; 19.13 is to use set-menubar-dirty-flag. +;; +;; Mar 13 1996 19.28 [andersl 1.24] +;; - Corrected one minor bug in folding-check-if-folding-allowed +;; +;; Mar 12 1996 19.28 [jari 1.23] +;; - Renamed all -func variables to -function. +;; +;; mar 12 1996 19.28 [jari 1.22] +;; - Added new example how to change the fold marks. The automatic folding +;; was reported to cause unnecessary delays for big files (eg. when using +;; ediff) Now there is new function variable which can totally disable +;; automatic folding if the return value is nil. +;; +;; folding-check-allow-folding-function :+ new variable +;; folding-check-if-folding-allowed :+ new func +;; folding-mode-find-file :! modified +;; folding-mode-write-file :! better docs +;; folding-goto-line :! arg "n" --> "N" due to XEmacs 19.13 +;; +;; Mar 11 1996 19.28 [jari 1.21] +;; - Integrated changes made by Anders' to v1.19 [folding in beta dir] +;; +;; Jan 25 1996 19.28 [jari 1.20] +;; - ** Mainly cosmetic changes ** +;; - Added some 'Section' codes that can be used with lisp-mnt.el +;; - Deleted all code in 'special section' because it was never used. +;; - Moved some old "-v-" named variables to better names. +;; - Removed folding-mode-flag that was never used. +;; +;; Jan 25 1996 19.28 [jari 1.19] +;; - Put Anders' latest version into RCS tree. +;; +;; Jan 03 1996 19.30 [andersl] +;; - `folding-mouse-call-original' uses `call-interactively'. +;; `folding-mouse-context-sensitive' doesn't do `save-excursion'. +;; (More changes will come later.) +;; `folding-mouse-yank-at-p' macro corrected (quote added). +;; Error for `epoch::version' removed. +;; `folding-mark-look-at' Regexp change .* -> [^\n\r]* to avoid error. +;; +;; Nov 24 1995 19.28 [andersl] +;; - (sequencep ) added to the code which checks for the existence +;; of a tools menu. +;; +;; Aug 27 1995 19.28 19.12 [andersl] +;; - Keybindings restructured. They now conforms with the +;; new 19.29 styleguide. Old keybindings are still available. +;; - Menus new goes into the "Tools" menu, if present. +;; - `folding-mouse-open-close' renamed to +;; `folding-mouse-context-sensitive'. +;; - New entry `other' in `folding-behave-table' which defaults to +;; `folding-calling-original'. +;; - `folding-calling-original' now gets the event from `last-input-event' +;; if called without arguments (i.e. the way `folding-act' calls it.) +;; - XEmacs mouse support added. +;; - `folding-mouse-call-original' can call functions with or without +;; the Event argument. +;; - Byte compiler generates no errors neither for Emacs 19 and XEmacs. +;; +;; Aug 24 1995 19.28 [jari 1.17] +;; - To prevent infinite back calling loop, Anders suggested smart way +;; to detect that func call chain is started only once. +;; folding-calling-original :+ v, call chain terminator +;; "Internal" :! v, all private vars have this string +;; folding-mouse-call-original :! v, stricter chain check. +;; "copyright" :! t, newer notice +;; "commentary" :! t, ripped non-supported emacsen +;; +;; Aug 24 1995 19.28 [jari 1.16] +;; ** mouse interface rewritten +;; - Anders gave many valuable comments about simplifying the mouse usage, +;; he suggested that every mouse function should accept standard event, +;; and it should be called directly. +;; folding-global :- v, not needed +;; folding-mode-off-hook :- v, not needed +;; folding-mouse-action-table :- v, not needed any more +;; folding-default-keys-function :+ v, key settings +;; folding-default-mouse-keys-function:+ v, key settings +;; folding-mouse :- f, unnecessary +;; 'all mouse funcs' :! f, now accept "e" parameter +;; folding-default-keys :+ f, defines keys +;; folding-mouse-call-original :+ f, call orig mouse func +;; "examples" :! t, radical rewrote, only one left +;; +;; Aug 24 1995 19.28 [jari 1.15] +;; - some minor changes. If we're inside a fold, Mouse-3 will go one +;; level up if it points END or BEG marker. +;; folding-mouse-yank-at-point:! v, added 'up 'down +;; folding-mark-look-at :! f, more return values: '11 and 'end-in +;; folding-open-close :! f, bug, didn't exit if inside fold +;; PMIN, PMAX, NEXTP, add-l :+ more macros fom tinylibm.el +;; +;; Aug 23 1995 19.28 [andersl 1.14] +;; - Added `eval-when-compile' around 1.13 byte-compiler fix +;; to avoid code to be executed when using a byte-compiled version +;; of folding.el. +;; - Binds mode keys via `minor-mode-map-alist' +;; (i.e. `folding-merge-keymaps' is not used in modern Emacsen.) +;; This means that the user can not bind `folding-mode-map' to a new +;; keymap, \\(s\\|\\)he must modify the existing one. +;; - `defvars' for global feature test variables `folding-*-p'. +;; - `folding-mouse-open-close' now detects when the current fold was been +;; pressed. (The "current" is the fold around which the buffer is +;; narrowed.) +;; +;; Aug 23 1995 19.28 [jari 1.13] +;; - 19.28 Byte compile doesn't handle fboundp, boundp well. That's a bug. +;; Set some dummy functions to get cleaner output. +;; - The folding-mode-off doesn't seem very useful, because it +;; is never run when another major-mode is turned on ... maybe we should +;; utilize kill-all-local-variables-hooks with defadvice around +;; kill-all-local-variables ... +;; +;; folding-emacs-version :+ added. it was in the docs, but not defined +;; kill-all-local-variables-hooks :! v, moved to variable section +;; list-buffers-mode-alist :! v, --''-- +;; "compiler hacks" :+ section added +;; "special" :+ section added +;; "Compatibility" :! moved at the beginning +;; +;; Aug 22 1995 19.28 [jari 1.12] +;; - Only minor changes +;; BOLP, BOLPP, EOLP, EOLPP :+ f, macros added from tinylibm.el +;; folding-mouse-pick-move :! f, when cursor at beolp, move always up +;; "bindings" :+ added C-cv and C-cC-v +;; +;; Aug 22 1995 19.28 [jari 1.11] +;; - Inspired by mouse so much, that this revision contain substantial +;; changes and enhancements. Mouse is now powered! +;; - Anders wanted mouse to operate according to 'mouse cursor', not +;; current 'point'. +;; folding-mouse-yank-at-point: controls it. Phwew, I like this +;; one a lot. +;; +;; examples :! t, totally changed, now 2 choices +;; folding-mode-off-hook :+ v, when folding ends +;; folding-global :+ v, global store value +;; folding-mouse-action-table :! v, changed +;; folding-mouse :! f, stores event to global +;; folding-mouse-open-close :! f, renamed, mouse activated open +;; folding-mode :! f, added 'off' hook +;; folding-event-posn :+ f, handles FSF mouse event +;; folding-mouse-yank-at-p :+ f, check which mouse mode is on +;; folding-mouse-point :+ f, return working point +;; folding-mouse-move :+ f, mouse moving down , obsolete ?? +;; folding-mouse-pick-move :+ f, mouse move accord. fold mark +;; folding-next-visible-heading :+ f, from tinyfold.el +;; folding-previous-visible-heading :+ f, from tinyfold.el +;; folding-pick-move :+ f, from tinyfold.el +;; +;; +;; Aug 22 1995 19.28 [jari 1.10] +;; - Minor typing errors corrected : fol-open-close 'hide --> 'close +;; This caused error when trying to close open fold with mouse +;; when cursor was sitting on fold marker. +;; +;; Aug 22 1995 19.28 [jari 1.9] +;; - Having heard good suggestions from Anders...! +;; "install" : add-hook for folding missed +;; folding-open-close : generalized +;; folding-behave-table : NEW, logical behavior control +;; folding-:mouse-action-table : now folding-mouse-action-table +;; +;; - The mouse function seems to work with FSF emacs only, because +;; XEmacs doesn't know about double or triple clicks. We're working +;; on the problem... +;; +;; Aug 21 1995 19.28 [jari 1.8] +;; - Rearranged the file structure so that all variables are at the +;; beginning of file. With new functions, it easy to open-close +;; fold. Added word "code:" or "setup:" to the front of code folds, +;; so that the toplevel folds can be recognized more easily. +;; - Added example hook to install section for easy mouse use. +;; - Added new functions. +;; folding-get-mode-marks : return folding marks +;; folding-mark-look-at : status of current line, fold mark in it? +;; folding-mark-mouse : execute action on fold mark +;; +;; +;; Aug 17 1995 19.28/X19.12 [andersl 1.7] +;; - Failed when loaded into XEmacs, when `folding-mode-map' was +;; undefined. Folding marks for three new major modes added: +;; rexx-mode, erlang-mode and xerl-mode. +;; +;; Aug 14 1995 19.28 [jari 1.6] +;; - After I met Anders we exchanged some thoughts about usage philosophy +;; of error and signal commands. I was annoyed by the fact that they +;; couldn't be suppressed, when the error was "minor". Later Anders +;; developed fdb.el, which will be integrated to FSF 19.30. It +;; offers by-passing error/signal interference. +;; --> I changed back all the error commands that were taken away. +;; +;; Jun 02 1995 19.28 [andersl] +;; - "Narrow" not present in mode-line when in folding-mode. +;; +;; May 12 1995 19.28 [jari 1.5] +;; - Installation text cleaned: reference to 'install-it' removed, +;; because such function doesn't exist any more. The installation is +;; now automatic: it's done when user calls folding mode first time. +;; - Added 'private vars' section. made 'outside all folds' message +;; informational, not an error. +;; +;; May 12 1995 19.28 [jackr x.x] +;; - Corrected 'broken menu bar' problem. +;; - Even though make-sparse-keymap claims its argument (a string to +;; name the menu) is optional, it's not. Lucid has other +;; arrangements for the same thing.. +;; +;; May 10 1995 19.28 [jari 1.2] +;; - Moved provide to the end of file. +;; - Rearranged code so that the common functions are at the beginning. +;; Reprogrammed the whole installation with hooks. Added Write file +;; hook that makes sure you don't write in 'binary' while folding were +;; accidentally off. +;; - Added regexp text for certain files which are not allowed to +;; 'auto fold' when loaded. +;; - changed some 'error' commands to 'messages', this prevent screen +;; mixup when debug-on-error is set to t +;; + folding-list-delete , folding-msg , folding-mode-find-file , +;; folding-mode-write-file , folding-check-folded , folding-keep-hooked +;; +;; 1.7.4 May 04 1995 19.28 [jackr 1.11] +;; - Some compatibility changes: +;; v.18 doesn't allow an arg to make-sparse-keymap +;; testing epoch::version is trickier than that +;; free-variable reference cleanup +;; +;; 1.7.3 May 04 1995 19.28 [jari] +;; - Corrected folding-mode-find-file-hook , so that it has more +;; 'mode turn on' capabilities through user function +;; + folding-mode-write-file-hook: Makes sure your file is saved +;; properly, so that you don't end up saving in 'binary'. +;; + folding-check-folded: func, default checker provided +;; + folding-check-folded-file-function variable added, User can put his +;; 'detect folding.el file' methods here. +;; + folding-mode-install-it: func, Automatic installation with it +;; +;; 1.7.2 Apr 01 1995 19.28 [jackr] , Design support by [jari] +;; - Added folding to FSF & XEmacs menus +;; +;; 1.7.1 Apr 28 1995 19.28 [jackr] +;; - The folding editor's merge-keymap couldn't handle FSF menu-bar, +;; so some minor changes were made, previous is '>' and enhancements +;; are '>' +;; +;; < (buffer-disable-undo new-buffer) +;; --- +;; > (buffer-flush-undo new-buffer) +;; 1510,1512c1510 +;; < key (if (symbolp keycode) +;; < (vector keycode) +;; < (char-to-string keycode)) +;; --- +;; > key (char-to-string keycode) +;; 1802,1808d1799 +;; < ;;{{{ Compatibility hacks for various Emacs versions +;; < +;; < (or (fboundp 'buffer-disable-undo) +;; < (fset 'buffer-disable-undo (symbol-function 'buffer-flush-undo))) +;; < +;; < ;;}}} +;; +;; +;; X.x Dec 1 1994 19.28 [jari] +;; - Only minor change. Made the folding mode string user configurable. +;; Added these variables: +;; folding-mode-string, folding-inside-string,folding-inside-mode-name +;; - Changed revision number from 1.6.2 to 1.7 , so that people know +;; this package has changed. + +;;}}} + +;;; Code: + +;;{{{ setup: require packages + +;;; ......................................................... &require ... + +(eval-when-compile + (require 'cl)) + +(eval-and-compile + (autoload 'font-lock-fontify-region "font-lock") + ;; Forward declaration + (defvar global-font-lock-mode)) + +(require 'easymenu) + +(defvar folding-package-url-location + "Latest folding is available at http://cvs.xemacs.org/viewcvs.cgi/XEmacs/packages/xemacs-packages/text-modes/") + +;;}}} +;;{{{ setup: byte compiler hacks + +;;; ............................................. &byte-compiler-hacks ... +;;; - This really only should be evaluated in case we're about to byte +;;; compile this file. Since `eval-when-compile' is evaluated when +;;; the uncompiled version is used (great!) we test if the +;;; byte-compiler is loaded. + +;; Make sure `advice' is loaded when compiling the code. + +(eval-and-compile + (require 'advice) + (defvar folding-xemacs-p (or (boundp 'xemacs-logo) + (featurep 'xemacs)) + "Folding determines which emacs version it is running. t if Xemacs.") + ;; loading overlay.el package removes some byte compiler whinings. + ;; By default folding does not use overlay code. + (if folding-xemacs-p + (or (fboundp 'overlay-start) ;; Already loaded + (load "overlay" 'noerr) ;; No? Try loading it. + (message "\ +** folding.el: XEmacs 19.15+ has package overlay.el, try to get it. + This is only warning. Folding does not use overlays by + default. You can safely ignore possible overlay byte + compilation error + messages.")))) + +(eval-when-compile + + (when nil ;; Disabled 2000-01-05 + ;; While byte compiling + (if (string= (buffer-name) " *Compiler Input*") + (progn + (message "** folding.el:\ + Info, Ignore [X]Emacs's missing motion/event/posn functions calls")))) + + ;; ARGS: (symbol variable-p library) + (defadvice find-function-search-for-symbol (around folding act) + "Set folding flag for `find-file-noselect' to open all folds." + (let ((file (ad-get-arg 2))) + (when file + (message "FILE %s" file) + (put 'find-file-noselect 'folding file))) + ad-do-it + (put 'find-file-noselect 'folding nil)) + + (defun folding-find-file-noselect () + (let* ((file (get 'find-file-noselect 'folding)) + (buffer (and file + ;; It may be absolute path name, file.el, + ;; or just "file". + (or (find-buffer-visiting file) + (get-buffer file) + (get-buffer (concat file ".el")))))) + (when buffer + (with-current-buffer buffer + (when (symbol-value 'folding-mode) ;; Byte compiler silencer + (turn-off-folding-mode)))))) + + ;; See find.func.el find-function-search-for-symbol + ;; Make C-h f and mouse-click work to jump to a file. Folding mode + ;; Must be turned off due to regexps in find.func.el that can't + ;; search ^M lines. + + (defadvice find-file-noselect (after folding act) + "When called by `find-function-search-for-symbol', turn folding off." + (folding-find-file-noselect)) + + (defadvice make-sparse-keymap + (before + make-sparse-keymap-with-optional-argument + (&optional byte-compiler-happyfier) + activate) + "This advice does nothing except adding an optional argument +to keep the byte compiler happy when compiling Emacs specific code +with XEmacs.") + + ;; XEmacs and Emacs 19 differs when it comes to obsolete functions. + ;; We're using the Emacs 19 versions, and this simply makes the + ;; byte-compiler stop wining. (Why isn't there a warning flag which + ;; could have turned off?) + + (and (boundp 'mode-line-format) + (put 'mode-line-format 'byte-obsolete-variable nil)) + + (and (fboundp 'byte-code-function-p) + (put 'byte-code-function-p 'byte-compile nil)) + + (and (fboundp 'eval-current-buffer) + (put 'eval-current-buffer 'byte-compile nil))) + +(defsubst folding-preserve-active-region () + "In XEmacs keep the region alive. In Emacs do nothing." + (if (boundp 'zmacs-region-stays) ;Keep regions alive + (set 'zmacs-region-stays t))) ;use `set' to Quiet Emacs Byte Compiler + +;; Work around the NT Emacs Cut'n paste bug in selective-display which +;; doesn't preserve C-m's. Only installed in problematic Emacs and +;; in other cases these lines are no-op. + +(eval-and-compile + (when (and (not folding-xemacs-p) + (memq (symbol-value 'window-system) '(win32 w32)) ; NT Emacs + (string< emacs-version "20.4")) ;at least in 19.34 .. 20.3.1 + + (unless (fboundp 'char-equal) + (defalias 'char-equal 'equal)) + + (unless (fboundp 'subst-char) + (defun subst-char (str char to-char) + "Replace in STR every CHAR with TO-CHAR." + (let ((len (length str)) + (ret (copy-sequence str))) ;because 'aset' is destructive + (while (> len 0) + (if (char-equal (aref str (1- len)) char) + (aset ret (1- len) to-char)) + (decf len)) + ret))) + + (defadvice kill-new (around folding-win32-fix-selective-display act) + "In selective display, convert each C-m to C-a. See `current-kill'." + (let* ((string (ad-get-arg 0))) + (when (and selective-display (string-match "\C-m" (or string ""))) + (setq string (subst-char string ?\C-m ?\C-a))) + ad-do-it)) + + (defadvice current-kill (around folding-win32-fix-selective-display act) + "In selective display, convert each C-a back to C-m. See `kill-new'." + ad-do-it + (let* ((string ad-return-value)) + (when (and selective-display (string-match "\C-a" (or string ""))) + (setq string (subst-char string ?\C-a ?\C-m)) + (setq ad-return-value string)))))) + +(defvar folding-mode) ;; Byte Compiler silencer + +(when (locate-library "mode-motion") ;; XEmacs + (defun folding-mode-motion-highlight-fold (event) + "Highlight line under mouse if it has a foldmark." + (when folding-mode + (funcall + ;; Emacs Byte Compiler Shutup fix + (symbol-function 'mode-motion-highlight-internal) + event + (function + (lambda () + (beginning-of-line) + (if (folding-mark-look-at) + (search-forward-regexp "^[ \t]*")))) + (function + (lambda () + (if (folding-mark-look-at) + (end-of-line))))))) + (require 'mode-motion) + (add-hook 'mode-motion-hook 'folding-mode-motion-highlight-fold 'at-end)) + +;;}}} + +;;{{{ setup: some variable + +;;; .................................................. &some-variables ... + +;; This is a list of structures which keep track of folds being entered +;; and exited. It is a list of (MARKER . MARKER) pairs, followed by the +;; symbol `folded'. The first of these represents the fold containing +;; the current one. If the view is currently outside all folds, this +;; variable has value nil. + +(defvar folding-stack nil + "Internal. A list of marker pairs representing folds entered so far.") + +(defvar folding-version (substring "$Revision: 1.5 $" 11 15) + "Version number of folding.el.") + +;;}}} +;;{{{ setup: bind + +;;; .......................................................... &v-bind ... + +(defgroup folding nil + "Managing buffers with Folds." + :group 'tools) + +(defcustom folding-mode-prefix-key "\C-c@" + "*Prefix key to use for Folding commands in Folding mode." + :type 'string + :group 'folding) + +(defcustom folding-goto-key "\M-g" + "*Key to be bound to `folding-goto-line' in folding mode. +The default value is M - g, but you probably don't want folding to +occupy it if you have used M - g got `goto-line'." + :type 'string + :group 'folding) + +(defcustom folding-font-lock-begin-mark 'font-lock-reference-face + "Face to highlight beginning fold mark." + :type 'face + :group 'folding) + +(defcustom folding-font-lock-end-mark 'font-lock-reference-face + "Face to highlight end fold mark." + :type 'face + :group 'folding) + +(defvar folding-mode-map nil + "Keymap used in Folding mode (a minor mode).") + +(defvar folding-mode-prefix-map nil + "Keymap used in Folding mode keys sans `folding-mode-prefix-key'.") + +;;;###autoload +(defvar folding-mode nil + "When Non nil, Folding mode is active in the current buffer.") + +(make-variable-buffer-local 'folding-mode) +(set-default 'folding-mode nil) + +(defmacro folding-kbd (key function) + "Folding: define KEY with FUNCTION to `folding-mode-prefix-map'. +This is used when assigning keybindings to `folding-mode-map'. +See also `folding-mode-prefix-key'." + `(define-key + folding-mode-prefix-map + ,key ,function)) + +(defun folding-bind-default-mouse () + "Bind default mouse keys used by Folding mode." + (interactive) + (cond + (folding-xemacs-p + (define-key folding-mode-map [(button3)] + 'folding-mouse-context-sensitive) + ;; (define-key folding-mode-map '(double button3) 'folding-hide-current-entry) + (define-key folding-mode-map [(control shift button2)] + 'folding-mouse-pick-move)) + (t + (define-key folding-mode-map [mouse-3] 'folding-mouse-context-sensitive) + (define-key folding-mode-map [C-S-mouse-2] 'folding-mouse-pick-move)))) + +(defun folding-bind-terminal-keys () + "In non-window system, rebind C - f and C - b as folding-{forward,backward}-char." + (unless (or (and (boundp 'window-system) ;; Emacs + (symbol-value 'window-system)) ;; Byte compiler silencer + (and (fboundp 'console-type) ;; XEmacs + (let ((val (fboundp 'console-type))) + (not (eq 'tty val))))) + (define-key folding-mode-map "\C-f" 'folding-forward-char) + (define-key folding-mode-map "\C-b" 'folding-backward-char))) + +(defun folding-bind-default-keys () + "Bind the default keys used the `folding-mode'. + +The variable `folding-mode-prefix-key' contains the prefix keys, +the default is C - c @. + +For the good ol' key bindings, please use the function +`folding-bind-backward-compatible-keys' instead." + (interactive) + (define-key folding-mode-map folding-goto-key 'folding-goto-line) + (folding-bind-terminal-keys) + (define-key folding-mode-map "\C-e" 'folding-end-of-line) + (folding-kbd "\C-f" 'folding-fold-region) + (folding-kbd ">" 'folding-shift-in) + (folding-kbd "<" 'folding-shift-out) + (folding-kbd "\C-t" 'folding-show-all) + (folding-kbd "\C-s" 'folding-show-current-entry) + (folding-kbd "\C-x" 'folding-hide-current-entry) + (folding-kbd "\C-o" 'folding-open-buffer) + (folding-kbd "\C-w" 'folding-whole-buffer) + (folding-kbd "\C-r" 'folding-convert-buffer-for-printing) + (folding-kbd "\C-k" 'folding-marks-kill) + (folding-kbd "\C-v" 'folding-pick-move) + (folding-kbd "v" 'folding-previous-visible-heading) + (folding-kbd " " 'folding-next-visible-heading) + (folding-kbd "." 'folding-context-next-action) + ;; C-u: kinda "up" -- "down" + (folding-kbd "\C-u" 'folding-toggle-enter-exit) + (folding-kbd "\C-q" 'folding-toggle-show-hide) + ;; Think "#" as a 'fence' + (folding-kbd "#" 'folding-region-open-close) + ;; Esc-; is the standard emacs commend add key. + (folding-kbd ";" 'folding-comment-fold) + (folding-kbd "%" 'folding-convert-to-major-folds) + (folding-kbd "/" 'folding-all-comment-blocks-in-region) + (folding-kbd "\C-y" 'folding-show-current-subtree) + (folding-kbd "\C-z" 'folding-hide-current-subtree) + (folding-kbd "\C-n" 'folding-display-name) + (folding-kbd "I" 'folding-insert-advertise-folding-mode)) + +(defun folding-bind-backward-compatible-keys () + "Bind keys traditionally used by Folding mode. +For bindings which follow newer Emacs minor mode conventions, please +use the function `folding-bind-default-keys'. + +This function sets `folding-mode-prefix-key' to `C-c'." + (interactive) + (setq folding-mode-prefix-key "\C-c") + (folding-bind-default-keys)) + +(defun folding-bind-outline-compatible-keys () + "Bind keys used by the minor mode `folding-mode'. +The keys used are as much as possible compatible with +bindings used by Outline mode. + +Currently, some outline mode functions doesn't have a corresponding +folding function. + +The variable `folding-mode-prefix-key' contains the prefix keys, +the default is C - c @. + +For the good ol' key bindings, please use the function +`folding-bind-backward-compatible-keys' instead." + (interactive) + ;; Traditional keys: + (folding-bind-terminal-keys) + (define-key folding-mode-map "\C-e" 'folding-end-of-line) + ;; Mimic Emacs 20.3 allout.el bindings + (folding-kbd ">" 'folding-shift-in) + (folding-kbd "<" 'folding-shift-out) + (folding-kbd "\C-n" 'folding-next-visible-heading) + (folding-kbd "\C-p" 'folding-previous-visible-heading) + ;; ("\C-u" outline-up-current-level) + ;; ("\C-f" outline-forward-current-level) + ;; ("\C-b" outline-backward-current-level) + ;; (folding-kbd "\C-i" 'folding-show-current-subtree) + (folding-kbd "\C-s" 'folding-show-current-subtree) + (folding-kbd "\C-h" 'folding-hide-current-subtree) + (folding-kbd "\C-k" 'folding-marks-kill) + (folding-kbd "!" 'folding-show-all) + (folding-kbd "\C-d" 'folding-hide-current-entry) + (folding-kbd "\C-o" 'folding-show-current-entry) + ;; (" " outline-open-sibtopic) + ;; ("." outline-open-subtopic) + ;; ("," outline-open-supertopic) + ;; Other bindings not in allout.el + (folding-kbd "\C-a" 'folding-open-buffer) + (folding-kbd "\C-q" 'folding-whole-buffer) + (folding-kbd "\C-r" 'folding-convert-buffer-for-printing) + (folding-kbd "\C-w" 'folding-fold-region) + (folding-kbd "I" 'folding-insert-advertise-folding-mode)) + +;;{{{ goto-line (advice) + +(defcustom folding-advice-instantiate t + "*In non-nil install advice code. Eg for `goto-line'." + :type 'boolean + :group 'folding) + +(defcustom folding-shift-in-on-goto t + "*Flag in folding adviced function `goto-line'. +If non-nil, folds are entered when going to a given line. +Otherwise the buffer is unfolded. Can also be set to 'show. +This variable is used only if `folding-advice-instantiate' was +non-nil when folding was loaded. + +See also `folding-goto-key'." + :type 'boolean + :group 'folding) + +(defvar folding-narrow-by-default t + "If t (default) things like isearch will enter folds. If nil the +folds will be opened, but not entered.") + +(when folding-advice-instantiate + (eval-when-compile (require 'advice)) + ;; By Robert Marshall + (defadvice goto-line (around folding-goto-line first activate) + "Go to line ARG, entering folds if `folding-shift-in-on-goto' is t. +It attempts to keep the buffer in the same visibility state as before." + (let () ;; (oldposn (point)) + ad-do-it + (if (and folding-mode + (or (folding-point-folded-p (point)) + (<= (point) (point-min-marker)) + (>= (point) (point-max-marker)))) + (let ((line (ad-get-arg 0))) + (if folding-shift-in-on-goto + (progn + (folding-show-all) + (goto-char 1) + (and (< 1 line) + (not (folding-use-overlays-p)) + (re-search-forward "[\n\C-m]" nil 0 (1- line))) + (let ((goal (point))) + (while (prog2 (beginning-of-line) + (if folding-shift-in-on-goto + (progn + (folding-show-current-entry t t) + (folding-point-folded-p goal)) + (folding-shift-in t)) + (goto-char goal))) + (folding-narrow-to-region + (and folding-narrow-by-default (point-min)) + (point-max) t))) + (if (or folding-stack (folding-point-folded-p (point))) + (folding-open-buffer)))))))) + +;;}}} + +(defun folding-bind-foldout-compatible-keys () + "Bind keys for `folding-mode' compatible with Foldout mode. + +The variable `folding-mode-prefix-key' contains the prefix keys, +the default is C - c @." + (interactive) + (folding-kbd "\C-z" 'folding-shift-in) + (folding-kbd "\C-x" 'folding-shift-out)) + +;;; This function is here, just in case we ever would like to add +;;; `hideif' support to folding mode. Currently, it is only used to +;;; which keys shouldn't be used. + +;;(defun folding-bind-hideif-compatible-keys () +;; "Bind keys for `folding-mode' compatible with Hideif mode. +;; +;;The variable `folding-mode-prefix-key' contains the prefix keys, +;;the default is C-c@." +;; (interactive) +;; ;; Keys defined by `hideif' +;; ;; (folding-kbd "d" 'hide-ifdef-define) +;; ;; (folding-kbd "u" 'hide-ifdef-undef) +;; ;; (folding-kbd "D" 'hide-ifdef-set-define-alist) +;; ;; (folding-kbd "U" 'hide-ifdef-use-define-alist) +;; +;; ;; (folding-kbd "h") 'hide-ifdefs) +;; ;; (folding-kbd "s") 'show-ifdefs) +;; ;; (folding-kbd "\C-d") 'hide-ifdef-block) +;; ;; (folding-kbd "\C-s") 'show-ifdef-block) +;; +;; ;; (folding-kbd "\C-q" 'hide-ifdef-toggle-read-only) +;; ) + +;;; .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. . + +;; Not used for modern Emacsen. +(defvar folding-saved-local-keymap nil + "Keymap used to save non-folding keymap. +(so it can be restored when folding mode is turned off.)") + +;;;###autoload +(defcustom folding-default-keys-function 'folding-bind-default-keys + "*Function or list of functions used to define keys for Folding mode. +Possible values are: + folding-bind-default-key + The standard keymap. + + `folding-bind-backward-compatible-keys' + Keys used by older versions of Folding mode. This function + does not conform to Emacs 19.29 style conversions concerning + key bindings. The prefix key is C - c + + `folding-bind-outline-compatible-keys' + Define keys compatible with Outline mode. + + `folding-bind-foldout-compatible-keys' + Define some extra keys compatible with Foldout. + +All except `folding-bind-backward-compatible-keys' used the value of +the variable `folding-mode-prefix-key' as prefix the key. +The default is C - c @" + :type 'function + :group 'folding) + +;; Not yet implemented: +;; folding-bind-hideif-compatible-keys +;; Define some extra keys compatible with hideif. + +;;;###autoload +(defcustom folding-default-mouse-keys-function 'folding-bind-default-mouse + "*Function to bind default mouse keys to `folding-mode-map'." + :type 'function + :group 'folding) + +(defvar folding-mode-menu nil + "Keymap containing the menu for Folding mode.") + +(defvar folding-mode-menu-name "Fld" ;; Short menu name + "Name of pull down menu.") + +;;}}} +;;{{{ setup: hooks + +;;; ......................................................... &v-hooks ... + +(defcustom folding-mode-hook nil + "*Hook called when Folding mode is entered. + +A hook named `-folding-hook' is also called, if it +exists. Eg., `c-mode-folding-hook' is called whenever Folding mode is +started in C mode." + :type 'hook + :group 'folding) + +(defcustom folding-load-hook nil + "*Hook run when file is loaded." + :type 'hook + :group 'folding) + +;;}}} +;;{{{ setup: user config + +;;; ........................................................ &v-Config ... + +;; Q: should this inherit mouse-yank-at-point's value? maybe not. +(defvar folding-mouse-yank-at-point t + "If non-nil, mouse activities are done at point instead of 'mouse cursor'. +Behaves like `mouse-yank-at-point'.") + +(defcustom folding-folding-on-startup t + "*If non-nil, buffers are folded when starting Folding mode." + :type 'boolean + :group 'folding) + +(defcustom folding-internal-margins 1 + "*Number of blank lines left next to fold mark when tidying folds. + +This variable is local to each buffer. To set the default value for all +buffers, use `set-default'. + +When exiting a fold, and at other times, `folding-tidy-inside' is invoked +to ensure that the fold is in the correct form before leaving it. This +variable specifies the number of blank lines to leave between the +enclosing fold marks and the enclosed text. + +If this value is nil or negative, no blank lines are added or removed +inside the fold marks. A value of 0 (zero) is valid, meaning leave no +blank lines. + +See also `folding-tidy-inside'." + :type 'boolean + :group 'folding) + +(make-variable-buffer-local 'folding-internal-margins) + +(defvar folding-mode-string " Fld" + "Buffer-local variable that hold the fold depth description.") + +(set-default 'folding-mode-string " Fld") + +;; Sets `folding-mode-string' appropriately. This allows the Folding mode +;; description in the mode line to reflect the current fold depth. + +(defconst folding-inside-string " " ; was ' inside ', + "Mode line addition to show 'inside' levels of fold.") + +;;;###autoload +(defcustom folding-inside-mode-name "Fld" + "*Mode line addition to show inside levels of 'fold' ." + :type 'string + :group 'folding) + +(defcustom folding-check-folded-file-function + 'folding-check-folded + "*Function that return t or nil after examining if the file is folded." + :type 'function + :group 'folding) + +(defcustom folding-check-allow-folding-function + 'folding-check-if-folding-allowed + "*Function that return t or nil after deciding if automatic folding." + :type 'function + :group 'folding) + +;;;###autoload +(defcustom folding-mode-string "Fld" + "*The minor mode string displayed when mode is on." + :type 'string + :group 'folding) + +;;;###autoload +(defcustom folding-mode-hook-no-regexp "RMAIL" + "*Regexp which disable automatic folding mode turn on for certain files." + :type 'string + :group 'folding) + +;;; ... ... ... ... ... ... ... ... ... ... ... ... ... .... &v-tables ... + +(defcustom folding-behave-table + '((close folding-hide-current-entry) + (open folding-show-current-entry) ; Could also be `folding-shift-in'. + (up folding-shift-out) + (other folding-mouse-call-original)) + "*Table of of logical commands and their associated functions. +If you want fold to behave like `folding-shift-in', when it 'open' +a fold, you just change the function entry in this table. + +Table form: + '( (LOGICAL-ACTION CMD) (..) ..)" + :type '(repeat + (symbol :tag "logical action") + (function :tag "callback")) + :group 'folding) + +;;; ... ... ... ... ... ... ... ... ... ... ... ... ... ..... &v-marks ... + +;;;###autoload +(defvar folding-mode-marks-alist nil + "List of (major-mode . fold mark) default combinations to use. +When Folding mode is started, the major mode is checked, and if there +are fold marks for that major mode stored in `folding-mode-marks-alist', +those marks are used by default. If none are found, the default values +of \"{{{ \" and \"}}}\" are used. + +Use function `folding-add-to-marks-list' to add more fold marks. The function +also explains the alist use in details. + +Use function `folding-set-local-variables' if you change the current mode's +folding marks during the session.") + +;;}}} +;;{{{ setup: private + +;;; ....................................................... &v-private ... + +(defvar folding-narrow-placeholder nil + "Internal. Mark where \"%n\" used to be in `mode-line-format'. +Must be nil.") + +(defvar folding-bottom-mark nil + "Internal marker of the true bottom of a fold.") + +(defvar folding-bottom-regexp nil + "Internal. Regexp marking the bottom of a fold.") + +(defvar folding-regexp nil + "Internal. Regexp for hunting down the `folding-top-mark' even in comments.") + +(defvar folding-secondary-top-mark nil + "Internal. Additional stuff that can be inserted as part of a top marker.") + +(defvar folding-top-mark nil + "Internal. The actual string marking the top of a fold.") + +(defvar folding-top-regexp nil + "Internal. +Regexp describing the string beginning a fold, possible with +leading comment thingies and like that.") + +(defvar folded-file nil + "Enter folding mode when this file is loaded. +(buffer local, use from a local variables list).") + +(defvar folding-calling-original nil + "Internal. Non-nil when original mouse binding is executed.") + +(defvar folding-narrow-overlays nil + "Internal. Keep the list of overlays.") +(make-variable-buffer-local 'folding-narrow-overlays) + +(defcustom folding-allow-overlays nil + "*If non-nil use overlay code. If nil, then selective display is used. +Note, that this code is highly experimental and will not most likely do what +you expect. using value t will not change folding to use overlays +completely. This variable was introduced to experiment with the overlay +interface, but the work never finished and it is unlikely that it +will continued any later time. Folding at present state is designed +too highly for selective display to make the change worthwhile." + :type 'boolean + :group 'folding) + +;;}}} +;;{{{ Folding install + +(defun folding-easy-menu-define () + "Define folding easy menu." + (interactive) + (easy-menu-define + folding-mode-menu + (if folding-xemacs-p + nil + (list folding-mode-map)) + "Folding menu" + (list + folding-mode-menu-name + ["Enter Fold" folding-shift-in t] + ["Exit Fold" folding-shift-out t] + ["Show Fold" folding-show-current-entry t] + ["Hide Fold" folding-hide-current-entry t] + "----" + ["Show Whole Buffer" folding-open-buffer t] + ["Fold Whole Buffer" folding-whole-buffer t] + ["Show subtree" folding-show-current-subtree t] + ["Hide subtree" folding-hide-current-subtree t] + ["Display fold name" folding-display-name t] + "----" + ["Move previous" folding-previous-visible-heading t] + ["Move next" folding-next-visible-heading t] + ["Pick fold" folding-pick-move t] + ["Next action (context)" folding-context-next-action t] + "----" + ["Foldify region" folding-fold-region t] + ["Open or close folds in region" folding-region-open-close t] + ["Open folds to top level" folding-show-all t] + "----" + ["Comment text in fold" folding-comment-fold t] + ["Convert for printing(temp buffer)" + folding-convert-buffer-for-printing t] + ["Convert to major-mode folds" folding-convert-to-major-folds t] + ["Move comments inside folds in region" + folding-all-comment-blocks-in-region t] + ["Delete fold marks in this fold" folding-marks-kill t] + ["Insert folding URL reference" + folding-insert-advertise-folding-mode t] + "----" + ["Toggle enter and exit mode" folding-toggle-enter-exit t] + ["Toggle show and hide" folding-toggle-show-hide t] + "----" + ["Folding mode off" folding-mode t]))) + +(defun folding-install-keymaps () + "Install keymaps." + (unless folding-mode-map + (setq folding-mode-map (make-sparse-keymap))) + (unless folding-mode-prefix-map + (setq folding-mode-prefix-map (make-sparse-keymap))) + (if (listp folding-default-keys-function) + (mapc 'funcall folding-default-keys-function) + (funcall folding-default-keys-function)) + (funcall folding-default-mouse-keys-function) + (folding-easy-menu-define) + (define-key folding-mode-map + folding-mode-prefix-key folding-mode-prefix-map) + ;; Install the keymap into `minor-mode-map-alist'. The keymap will + ;; be activated as soon as the variable `folding-mode' is set to + ;; non-nil. + (let ((elt (assq 'folding-mode minor-mode-map-alist))) + ;; Always remove old map before adding new definitions. + (if elt + (setq minor-mode-map-alist + (delete elt minor-mode-map-alist))) + (push (cons 'folding-mode folding-mode-map) minor-mode-map-alist)) + ;; Update minor-mode-alist + (or (assq 'folding-mode minor-mode-alist) + (push '(folding-mode folding-mode-string) minor-mode-alist)) + ;; Needed for XEmacs + (or (fboundp 'buffer-disable-undo) + (fset 'buffer-disable-undo (symbol-function 'buffer-flush-undo)))) + +(defun folding-uninstall-keymaps () + "Uninstall keymaps." + (let ((elt (assq 'folding-mode minor-mode-map-alist))) + (if elt + (setq minor-mode-map-alist + (delete elt minor-mode-map-alist))) + (if (setq elt (assq 'folding-mode minor-mode-alist)) + (setq minor-mode-alist + (delete elt minor-mode-alist))) + (folding-uninstall-hooks))) + +(defun folding-install (&optional uninstall) + "Install or UNINSTALL folding." + (interactive "P") + (cond + (uninstall + (folding-uninstall-keymaps) + (folding-uninstall-hooks)) + (t + (folding-install-keymaps)))) + +(defun folding-uninstall () + "Uninstall folding." + (interactive) + (folding-install 'uninstall) + ;; Unwrap all buffers. + (dolist (buffer (buffer-list)) + (with-current-buffer buffer + (goto-char (point-min)) + (when (or folding-mode + ;; To be sure, check this at the same time + ;; Somebody may have just done + ;; (setq folding-mode nil), which is bad thing. + ;; Setting variable won't restore the buffer. + (re-search-forward "{{{" nil t)) + (turn-off-folding-mode))))) + +;;}}} +;;{{{ code: misc + +(defsubst folding-get-mode-marks (&optional mode) + "Return fold markers for MODE. default is for current `major-mode'. + +Return: + \(beg-marker end-marker\)" + (interactive) + (let* (elt) + (unless (setq elt (assq (or mode major-mode) + folding-mode-marks-alist)) + (error "Folding error: mode is not in `folding-mode-marks-alist'")) + (list (nth 1 elt) (nth 2 elt) (nth 3 elt)))) + +(defun folding-region-has-folding-marks-p (beg end) + "Check is there is fold mark in region BEG END." + (save-excursion + (goto-char beg) + (when (memq (folding-mark-look-at) '(1 11)) + (goto-char end) + (memq (folding-mark-look-at) '(end end-in))))) + +;;; - Thumb rule: because "{{{" if more meaningful, all returns values +;;; are of type integerp if it is found. +;;; +(defun folding-mark-look-at (&optional mode) + "Check status of current line. Does it contain a fold mark?. + +MODE + + 'move move over fold mark + +Return: + + 0 1 numberp, line has fold begin mark + 0 = closed, 1 = open, + 11 = open, we're inside fold, and this is top marker + + 'end end mark + + 'end-in end mark, inside fold, floor marker + + nil no fold marks .." + (let* (case-fold-search + (marks (folding-get-mode-marks)) + (stack folding-stack) + (bm (regexp-quote (nth 0 marks))) ;begin mark + (em (concat "^[ \t\n]*" (regexp-quote (nth 1 marks)))) + (bm-re (concat + (concat "^[ \t\n]*" bm) + (if (and nil + (string= + " " (substring (nth 0 marks) + (length (nth 1 marks))))) + ;; Like "}}} *" + "*" + ""))) + ret + point) + (save-excursion + (beginning-of-line) + (cond + ((looking-at bm-re) + (setq point (point)) + (cond + ((looking-at (concat "^[ \t\n]*" bm "[^\r\n]*\r")) ;; closed + (setq ret 0)) + (t ;; open fold marker + (goto-char (point-min)) + (cond + ((and stack ;; we're inside fold + ;; allow spaces + (looking-at (concat "[ \t\n]*" bm))) + (setq ret 11)) + (t + (setq ret 1)))))) + ((looking-at em) + (setq point (point)) + ;; - The stack is a list if we've entered inside fold. There + ;; is no text after fold END mark + ;; - At bol ".*\n[^\n]*" doesn't work but "\n[^\n]*" at eol does?? + (cond + ((progn + (end-of-line) + (or (and stack (eobp)) ;normal ending + (and stack ;empty newlines only, no text ? + (not (looking-at "\n[^ \t\n]*"))))) + (setq ret 'end-in)) + (t ;all rest are newlines + (setq ret 'end)))))) + (cond + ((and mode point) + (goto-char point) + ;; This call breaks if there is no marks on the point, + ;; because there is no parameter 'nil t' in call. + ;; --> there is error in this function if that happens. + (beginning-of-line) + (re-search-forward (concat bm "\\|" em)) + (backward-char 1))) + ret)) + +(defsubst folding-mark-look-at-top-mark-p () + "Check if line contain folding top marker." + (integerp (folding-mark-look-at))) + +(defsubst folding-mark-look-at-bottom-mark-p () + "Check if line contain folding bottom marker." + (symbolp (folding-mark-look-at))) + +(defun folding-act (action &optional event) + "Execute logical ACTION based on EVENT. + +References: + `folding-behave-table'" + (let* ((elt (assoc action folding-behave-table))) + (if elt + (funcall (nth 1 elt) event) + (error "Folding mode (folding-act): Unknown action %s" action)))) + +(defun folding-region-open-close (beg end &optional close) + "Open all folds inside region BEG END. Close if optional CLOSE is non-nil." + (interactive "r\nP") + (let* ((func (if (null close) + 'folding-show-current-entry + 'folding-hide-current-entry)) + tmp) + (save-excursion + ;; make sure the beg is first. + (if (> beg end) ;swap order + (setq tmp beg beg end end tmp)) + (goto-char beg) + (while (and + ;; the folding-show-current-entry/hide will move point + ;; to beg-of-line So we must move to the end of + ;; line to continue search. + (if (and close + (eq 0 (folding-mark-look-at))) ;already closed ? + t + (funcall func) + (end-of-line) + t) + (folding-next-visible-heading) + (< (point) end)))))) + +(defun fold-marks-kill () + "If over fold, open fold and kill beginning and end fold marker. +Return t ot nil if marks were removed." + (interactive) + (if (not (folding-mark-look-at)) + (when (called-interactively-p 'interactive) + (message "Folding: Cursor not over fold. Can't remove fold marks.") + nil) + (destructuring-bind (beg end) + (folding-show-current-entry) + (let ((kill-whole-line t)) + ;; must be done in this order, because point moves after kill. + (goto-char end) + (beginning-of-line) + (kill-line) + (goto-char beg) + (beginning-of-line) + (kill-line) + ;; Return status + t)))) + +(defun folding-hide-current-subtree () + "Call `folding-show-current-subtree' with argument 'hide." + (interactive) + (folding-show-current-subtree 'hide)) + +(defun folding-show-current-subtree (&optional hide) + "Show or HIDE all folds inside current fold. +Point must be over beginning fold mark." + (interactive "P") + (let* ((stat (folding-mark-look-at 'move)) + (beg (point)) + end) + (cond + ((memq stat '(0 1 11)) ;It's BEG fold + (when (eq 0 stat) ;it was closed + (folding-show-current-entry) + (goto-char beg)) ;folding-pick-move needs point at fold + (save-excursion + (if (folding-pick-move) + (setq end (point)))) + (if (and beg end) + (folding-region-open-close beg end hide))) + (t + (if (called-interactively-p 'interactive) + (message "point is not at fold beginning.")))))) + +(defun folding-display-name () + "Show current active fold name." + (interactive) + (let* ((pos (folding-find-folding-mark)) + name) + (when pos + (save-excursion + (goto-char pos) + (if (looking-at ".*[{]+") ;Drop "{" mark away. + (setq pos (match-end 0))) + (setq name (buffer-substring + pos + (progn + (end-of-line) + (point)))))) + (if name + (message (format "fold:%s" name))))) + +;;}}} +;;{{{ code: events + +(defun folding-event-posn (act event) + "According to ACT read mouse EVENT struct and return data from it. +Event must be simple click, no dragging. + +ACT + 'mouse-point return the 'mouse cursor' point + 'window return window pointer + 'col-row return list (col row)" + (cond + ((not folding-xemacs-p) + ;; short Description of FSF mouse event + ;; + ;; EVENT : (mouse-3 (# 128 (20 . 104) -23723628)) + ;; event-start : (# 128 (20 . 104) -23723628)) + ;; ^^^MP + ;; mp = mouse point + (let* ((el (funcall (symbol-function 'event-start) event))) + (cond + ((eq act 'mouse-point) + (nth 1 el)) ;is there macro for this ? + ((eq act 'window) + (funcall (symbol-function 'posn-window) el)) + ((eq act 'col-row) + (funcall (symbol-function 'posn-col-row) el)) + (t + (error "Unknown request %s" act))))) + (folding-xemacs-p + (cond + ((eq act 'mouse-point) + (funcall (symbol-function 'event-point) event)) + ((eq act 'window) + (funcall (symbol-function 'event-window) event)) + ;; Must be tested! (However, it's not used...) + ((eq act 'col-row) + (list (funcall (symbol-function 'event-x) event) + (funcall (symbol-function 'event-y) event))) + (t + (error "Unknown request %s" act)))) + (t + (error "This version of Emacs can't handle events.")))) + +(defmacro folding-interactive-spec-p () + "Preserve region during `interactive'. +In XEmacs user could also set `zmacs-region-stays'." + (if folding-xemacs-p + ;; preserve selected region + `'(interactive "_p") + `'(interactive "p"))) + +(defmacro folding-mouse-yank-at-p () + "Check if user use \"yank at mouse point\" feature. + +Please see the variable `folding-mouse-yank-at-point'." + 'folding-mouse-yank-at-point) + +(defun folding-mouse-point (&optional event) + "Return mouse's working point. Optional EVENT is mouse click. +When used on XEmacs, return nil if no character was under the mouse." + (if (or (folding-mouse-yank-at-p) + (null event)) + (point) + (folding-event-posn 'mouse-point event))) + +;;}}} + +;;{{{ code: hook + +(defmacro folding-find-file-hook () + "Return hook symbol for current version." + `(if (boundp 'find-file-hook) + 'find-file-hook + 'find-file-hooks)) + +(defmacro folding-write-file-hook () + "Return hook symbol for current version." + `(if (boundp 'write-file-functions) + 'write-file-functions + 'write-file-hooks)) + +(defun folding-is-hooked () + "Check if folding hooks are installed." + (and (memq 'folding-mode-write-file + (symbol-value (folding-write-file-hook))) + (memq 'folding-mode-find-file + (symbol-value (folding-find-file-hook))))) + +;;;###autoload +(defun folding-uninstall-hooks () + "Remove hooks set by folding." + (turn-off-folding-mode) + (remove-hook 'finder-mode-hook 'folding-mode) + (remove-hook 'write-file-hooks 'folding-mode-write-file) + (remove-hook 'find-file-hooks 'folding-mode-find-file)) + +;;;###autoload +(defun folding-install-hooks () + "Install folding hooks." + (folding-mode-add-find-file-hook) + (add-hook 'finder-mode-hook 'folding-mode) + (or (memq 'folding-mode-write-file (symbol-value (folding-write-file-hook))) + (add-hook (folding-write-file-hook) 'folding-mode-write-file 'end))) + +;;;###autoload +(defun folding-keep-hooked () + "Make sure hooks are in their places." + (unless (folding-is-hooked) + (folding-uninstall-hooks) + (folding-install-hooks))) + +;;}}} +;;{{{ code: Mouse handling + +(defun folding-mouse-call-original (&optional event) + "Execute original mouse function using mouse EVENT. + +Do nothing if original function does not exist. + +Does nothing when called by a function which has earlier been called +by us. + +Sets global: + `folding-calling-original'" + (interactive "@e") ;; Was "e" + ;; Without the following test we could easily end up in a endless + ;; loop in case we would call a function which would call us. + ;; + ;; (An easy constructed example is to bind the function + ;; `folding-mouse-context-sensitive' to the same mouse button both in + ;; `folding-mode-map' and in the global map.) + (if folding-calling-original + nil + ;; `folding-calling-original' is global + (setq folding-calling-original t) + (unwind-protect + (progn + (or event + (setq event last-input-event)) + (let (mouse-key) + (cond + ((not folding-xemacs-p) + (setq mouse-key (make-vector 1 (car-safe event)))) + (folding-xemacs-p + (setq mouse-key + (vector + (append + (event-modifiers event) + (list (intern + (format "button%d" + (funcall + (symbol-function 'event-button) + event)))))))) + (t + (error "This version of Emacs can't handle events."))) + ;; Test string: http://www.csd.uu.se/~andersl + ;; andersl A T csd uu se + ;; (I have `ark-goto-url' bound to the same key as + ;; this function.) + ;; + ;; turn off folding, so that we can see the real + ;; function behind it. + ;; + ;; We have to restore the current buffer, otherwise the + ;; let* won't be able to restore the old value of + ;; folding-mode. In my environment, I have bound a + ;; function which starts mail when I click on an e-mail + ;; address. When returning, the current buffer has + ;; changed. + (let* ((folding-mode nil) + (orig-buf (current-buffer)) + (orig-func (key-binding mouse-key))) + ;; call only if exist + (when orig-func + ;; Check if the original function has arguments. If + ;; it does, call it with the event as argument. + (unwind-protect + (progn + (setq this-command orig-func) + (call-interactively orig-func)) +;;; #untested, but included here for further reference +;;; (cond +;;; ((not (string-match "mouse" (symbol-name orig-func))) +;;; (call-interactively orig-func)) +;;; ((string-match "^mouse" (symbol-name orig-func)) +;;; (funcall orig-func event)) +;;; (t +;;; ;; Some other package's mouse command, +;;; ;; should we do something special here for +;;; ;; somebody? +;;; (funcall orig-func event))) + (set-buffer orig-buf)))))) + ;; This is always executed, even if the above generates an error. + (setq folding-calling-original nil)))) + +(defun folding-mouse-context-sensitive (event) + "Perform some operation depending on the context of the mouse pointer. +EVENT is mouse event. + +The variable `folding-behave-table' contains a mapping between contexts and +operations to perform. + +The following contexts can be handled (They are named after the +natural operation to perform on them): + + open - A folded fold. + close - An open fold, which isn't the one current topmost one. + up - The topmost visible fold. + other - Anything else. + +Note that the `pointer' can be either the buffer point, or the mouse +pointer depending in the setting of the user option +`folding-mouse-yank-at-point'." + (interactive "e") + (let* ( ;; - Get mouse cursor point, or point + (point (folding-mouse-point event)) + state) + (if (null point) + ;; The user didn't click on any text. + (folding-act 'other event) + (save-excursion + (goto-char point) + (setq state (folding-mark-look-at))) + (cond + ((eq state 0) + (folding-act 'open event)) + ((eq state 1) + (folding-act 'close event)) + ((eq state 11) + (folding-act 'up event)) + ((eq 'end state) + (folding-act 'close)) + ((eq state 'end-in) + (folding-act 'up event)) + (t + (folding-act 'other event)))))) + +;;; FIXME: #not used, the pick move handles this too +(defun folding-mouse-move (event) + "Move down if sitting on fold mark using mouse EVENT. + +Original function behind the mouse is called if no FOLD action wasn't +taken." + (interactive "e") + (let* ( ;; - Get mouse cursor point, or point + (point (folding-mouse-point event)) + state) + (save-excursion + (goto-char point) + (beginning-of-line) + (setq state (folding-mark-look-at))) + (cond + ((not (null state)) + (goto-char point) + (folding-next-visible-heading) t) + (t + (folding-mouse-call-original event))))) + +(defun folding-mouse-pick-move (event) + "Pick movement if sitting on beg/end fold mark using mouse EVENT. +If mouse if at the `beginning-of-line' point, then always move up. + +Original function behind the mouse is called if no FOLD action wasn't +taken." + (interactive "e") + (let* ( ;; - Get mouse cursor point, or point + (point (folding-mouse-point event)) + state) + (save-excursion + (goto-char point) + (setq state (folding-mark-look-at))) + (cond + ((not (null state)) + (goto-char point) + (if (= point + (save-excursion (beginning-of-line) (point))) + (folding-previous-visible-heading) + (folding-pick-move))) + (t + (folding-mouse-call-original event))))) + +;;}}} +;;{{{ code: engine + +(defun folding-set-mode-line () + "Update modeline with fold level." + (if (null folding-stack) + (kill-local-variable 'folding-mode-string) + (make-local-variable 'folding-mode-string) + (setq folding-mode-string + (if (eq 'folded (car folding-stack)) + (concat + folding-inside-string "1" folding-inside-mode-name) + (concat + folding-inside-string + (int-to-string (length folding-stack)) + folding-inside-mode-name))))) + +(defun folding-clear-stack () + "Clear the fold stack, and release all the markers it refers to." + (let ((stack folding-stack)) + (setq folding-stack nil) + (while (and stack (not (eq 'folded (car stack)))) + (set-marker (car (car stack)) nil) + (set-marker (cdr (car stack)) nil) + (setq stack (cdr stack))))) + +(defun folding-check-if-folding-allowed () + "Return non-nil when buffer allowed to be folded automatically. +When buffer is loaded it may not be desirable to fold it immediately, +because the file may be too large, or it may contain fold marks, that +really are not _real_ folds. (Eg. RMAIL saved files may have the +marks) + +This function returns t, if it's okay to proceed checking the fold status +of file. Returning nil means that folding should not touch this file. + +The variable `folding-check-allow-folding-function' normally contains this +function. Change the variable to use your own scheme." + + (or (let ((file (get 'find-file-noselect 'folding))) + ;; When a file reference is "pushed" is a C-h v buffer that says: + ;; test is a Lisp function in `~/foo/tmp/test.el' A flag gets set + ;; (see adviced code) and we must not fold this buffer, because + ;; it will be immediately searched. + (and file + (not (string-match (regexp-quote file) + (or buffer-file-name ""))))) + ;; Do not fold these files + (null (string-match folding-mode-hook-no-regexp (buffer-name))))) + +(defun folding-mode-find-file () + "One of the funcs called whenever a `find-file' is successful. +It checks to see if `folded-file' has been set as a buffer-local +variable, and automatically starts Folding mode if it has. + +This allows folded files to be automatically folded when opened. + +To make this hook effective, the symbol `folding-mode-find-file-hook' +should be placed at the end of `find-file-hooks'. If you have +some other hook in the list, for example a hook to automatically +uncompress or decrypt a buffer, it should go earlier on in the list. + +See also `folding-mode-add-find-file-hook'." + (let* ((check-fold folding-check-folded-file-function) + (allow-fold folding-check-allow-folding-function)) + ;; Turn mode on only if it's allowed + (if (funcall allow-fold) + (or (and (and check-fold (funcall check-fold)) + (folding-mode 1)) + (and (assq 'folded-file (buffer-local-variables)) + folded-file + (folding-mode 1) + (kill-local-variable 'folded-file))) + ;; In all other cases, unfold buffer. + (if folding-mode + (folding-mode -1))))) + +;;;###autoload +(defun folding-mode-add-find-file-hook () + "Append `folding-mode-find-file-hook' to the list `find-file-hooks'. + +This has the effect that afterwards, when a folded file is visited, if +appropriate Emacs local variable entries are recognized at the end of +the file, Folding mode is started automatically. + +If `inhibit-local-variables' is non-nil, this will not happen regardless +of the setting of `find-file-hooks'. + +To declare a file to be folded, put `folded-file: t' in the file's +local variables. eg., at the end of a C source file, put: + +/* +Local variables: +folded-file: t +*/ + +The local variables can be inside a fold." + (interactive) + (or (memq 'folding-mode-find-file (symbol-value (folding-find-file-hook))) + (add-hook (folding-find-file-hook) 'folding-mode-find-file 'end))) + +(defun folding-mode-write-file () + "Folded files must be controlled by folding before saving. +This function turns on the folding mode if it is not activated. +It prevents 'binary pollution' upon save." + (let* ((check-func folding-check-folded-file-function) + (no-re folding-mode-hook-no-regexp) + (bn (or (buffer-name) ""))) + (if (and (not (string-match no-re bn)) + (boundp 'folding-mode) + (null folding-mode) + (and check-func (funcall check-func))) + (progn + ;; When folding mode is turned on it also 'folds' whole + ;; buffer... can't avoid that, since it's more important + ;; to save safely + (folding-mode 1))) + ;; hook returns nil, good habit + nil)) + +(defun folding-check-folded () + "Function to determine if this file is in folded form." + (let* ( ;; Could use folding-top-regexp , folding-bottom-regexp , + ;; folding-regexp But they are not available at load time. + (folding-re1 "^.?.?.?{{{") + (folding-re2 "[\r\n].*}}}")) + (save-excursion + (goto-char (point-min)) + ;; If we found both, we assume file is folded + (and (re-search-forward folding-re1 nil t) + ;; if file is folded, there are \r's + (search-forward "\r" nil t) + (re-search-forward folding-re2 nil t))))) + +;;}}} + +;;{{{ code: Folding mode + +(defun folding-font-lock-keywords (&optional mode) + "Return folding font-lock keywords for MODE." + ;; Add support mode-by-mode basis. Check if mode is already + ;; handled from the property list. + (destructuring-bind (beg end ignore) + (folding-get-mode-marks (or mode major-mode)) + ;; `ignore' is not used, add no-op for byte compiler + (or ignore + (setq ignore t)) + (setq beg (concat "^[ \t]*" (regexp-quote beg) "[^\r\n]+")) + (setq end (concat "^[ \t]*" (regexp-quote end))) + (list + ;; the `t' says to overwrite any previous highlight. + ;; => Needed because folding marks are in comments. + (list beg 0 folding-font-lock-begin-mark t) + (list end 0 folding-font-lock-end-mark t)))) + +(defun folding-font-lock-support-instantiate (&optional mode) + "Add fold marks with `font-lock-add-keywords'." + (or mode + (setq mode major-mode)) + ;; Hide function from Byte Compiler. + (let ((function 'font-lock-add-keywords)) + (when (fboundp function) + (funcall function + mode + (folding-font-lock-keywords mode)) + ;; In order to see new keywords font lock must be restarted. + (dolist (buffer (buffer-list)) + (with-current-buffer buffer + (when (and (eq major-mode mode) + (or font-lock-mode + (and (boundp 'global-font-lock-mode) + global-font-lock-mode))) + ;; FIXME: Crude fix. should we use font-lock-fontify-buffer instead? + (font-lock-mode -1) + (font-lock-mode 1))))))) + +(defun folding-font-lock-support () + "Add font lock support." + (let ((list (get 'folding-mode 'font-lock))) + (unless (memq major-mode list) + ;; Support added, update known list + (push major-mode list) + (put 'folding-mode 'font-lock list) + (folding-font-lock-support-instantiate major-mode)))) + +(defun folding-set-local-variables () + "Set local fold mark variables. +If you're going to change the beginning and end mark in +`folding-mode-marks-alist'; you must call this function." + (set (make-local-variable 'folding-stack) nil) + (make-local-variable 'folding-top-mark) + (make-local-variable 'folding-secondary-top-mark) + (make-local-variable 'folding-top-regexp) + (make-local-variable 'folding-bottom-mark) + (make-local-variable 'folding-bottom-regexp) + (make-local-variable 'folding-regexp) + (or (and (boundp 'folding-top-regexp) + folding-top-regexp + (boundp 'folding-bottom-regexp) + folding-bottom-regexp) + (let ((folding-marks (assq major-mode + folding-mode-marks-alist))) + (if folding-marks + (setq folding-marks (cdr folding-marks)) + (setq folding-marks '("{{{" "}}}"))) + (apply 'folding-set-marks folding-marks)))) + +;;;###autoload +(defun turn-off-folding-mode () + "Turn off folding." + (folding-mode -1)) + +;;;###autoload +(defun turn-on-folding-mode () + "Turn on folding." + (folding-mode 1)) + +;;;###autoload +(defun folding-mode (&optional arg inter) + "A folding-editor-like minor mode. ARG INTER. + +These are the basic commands that Folding mode provides: + +\\{folding-mode-map} + +Keys starting with `folding-mode-prefix-key' + +\\{folding-mode-prefix-map} + + folding-convert-buffer-for-printing: + `\\[folding-convert-buffer-for-printing]' + Makes a ready-to-print, formatted, unfolded copy in another buffer. + + Read the documentation for the above functions for more information. + +Overview + + Folds are a way of hierarchically organizing the text in a file, so + that the text can be viewed and edited at different levels. It is + similar to Outline mode in that parts of the text can be hidden from + view. A fold is a region of text, surrounded by special \"fold marks\", + which act like brackets, grouping the text. Fold mark pairs can be + nested, and they can have titles. When a fold is folded, the text is + hidden from view, except for the first line, which acts like a title + for the fold. + + Folding mode is a minor mode, designed to cooperate with many other + major modes, so that many types of text can be folded while they are + being edited (eg., plain text, program source code, Texinfo, etc.). + +Folding-mode function + + If Folding mode is not called interactively (`(called-interactively-p 'interactive)' is nil), + and it is called with two or less arguments, all of which are nil, then + the point will not be altered if `folding-folding-on-startup' is set + and `folding-whole-buffer' is called. This is generally not a good + thing, as it can leave the point inside a hidden region of a fold, but + it is required if the local variables set \"mode: folding\" when the + file is first read (see `hack-local-variables'). + + Not that you should ever want to, but to call Folding mode from a + program with the default behavior (toggling the mode), call it with + something like `(folding-mode nil t)'. + +Fold marks + + For most types of folded file, lines representing folds have \"{{{\" + near the beginning. To enter a fold, move the point to the folded line + and type `\\[folding-shift-in]'. You should no longer be able to see + the rest of the file, just the contents of the fold, which you couldn't + see before. You can use `\\[folding-shift-out]' to leave a fold, and + you can enter and exit folds to move around the structure of the file. + + All of the text is present in a folded file all of the time. It is just + hidden. Folded text shows up as a line (the top fold mark) with \"...\" + at the end. If you are in a fold, the mode line displays \"inside n + folds Narrow\", and because the buffer is narrowed you can't see outside + of the current fold's text. + + By arranging sections of a large file in folds, and maybe subsections + in sub-folds, you can move around a file quickly and easily, and only + have to scroll through a couple of pages at a time. If you pick the + titles for the folds carefully, they can be a useful form of + documentation, and make moving though the file a lot easier. In + general, searching through a folded file for a particular item is much + easier than without folds. + +Managing folds + + To make a new fold, set the mark at one end of the text you want in the + new fold, and move the point to the other end. Then type + `\\[folding-fold-region]'. The text you selected will be made into a + fold, and the fold will be entered. If you just want a new, empty fold, + set the mark where you want the fold, and then create a new fold there + without moving the point. Don't worry if the point is in the middle of + a line of text, `folding-fold-region' will not break text in the middle + of a line. After making a fold, the fold is entered and the point is + positioned ready to enter a title for the fold. Do not delete the fold + marks, which are usually something like \"{{{\" and \"}}}\". There may + also be a bit of fold mark which goes after the fold title. + + If the fold markers get messed up, or you just want to see the whole + unfolded file, use `\\[folding-open-buffer]' to unfolded the whole + file, so you can see all the text and all the marks. This is useful for + checking/correcting unbalanced fold markers, and for searching for + things. Use `\\[folding-whole-file]' to fold the buffer again. + + `folding-shift-out' will attempt to tidy the current fold just before + exiting it. It will remove any extra blank lines at the top and bottom, + \(outside the fold marks). It will then ensure that fold marks exists, + and if they are not, will add them (after asking). Finally, the number + of blank lines between the fold marks and the contents of the fold is + set to 1 (by default). + +Folding package customizations + + If the fold marks are not set on entry to Folding mode, they are set to + a default for current major mode, as defined by + `folding-mode-marks-alist' or to \"{{{ \" and \"}}}\" if none are + specified. + + To bind different commands to keys in Folding mode, set the bindings in + the keymap `folding-mode-map'. + + The hooks `folding-mode-hook' and `-folding-hook' are + called before folding the buffer and applying the key bindings in + `folding-mode-map'. This is a good hook to set extra or different key + bindings in `folding-mode-map'. Note that key bindings in + `folding-mode-map' are only examined just after calling these hooks; + new bindings in those maps only take effect when Folding mode is being + started. The hook `folding-load-hook' is called when Folding mode is + loaded into Emacs. + +Mouse behavior + + If you want folding to detect point of actual mouse click, please see + variable `folding-mouse-yank-at-p'. + + To customise the mouse actions, look at `folding-behave-table'." + (interactive) + + (let ((new-folding-mode + (if (not arg) + (not folding-mode) + (> (prefix-numeric-value arg) 0)))) + (or (eq new-folding-mode + folding-mode) + (if folding-mode + (progn + ;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ progn ^^^ + ;; turn off folding + (if (null (folding-use-overlays-p)) + (setq selective-display nil)) + (folding-clear-stack) + (folding-narrow-to-region nil nil) + (folding-subst-regions (list 1 (point-max)) ?\r ?\n) + + ;; Restore "%n" (Narrow) in the mode line + (setq mode-line-format + (mapcar + (function + (lambda (item) + (if (equal item 'folding-narrow-placeholder) + "%n" item))) + mode-line-format))) + ;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ else ^^^ + (cond + ((folding-use-overlays-p) + ;; This may be Emacs specific; how about XEmacs? + ;; + ;; make line-move-ignore-invisible buffer local, matches + ;; outline.el, and the 21 pre-release gets upset if this is + ;; defined globally in shell buffer... + (make-local-variable 'line-move-ignore-invisible) + (setq line-move-ignore-invisible t + buffer-invisibility-spec '((t . t)))) + (t + (setq selective-display t) + (setq selective-display-ellipses t))) + (unless (assq 'folding-mode minor-mode-alist) + ;; User has not run folding-install or he did call + ;; folding-uninstall which completely wiped package out. + ;; => anyway now he calls us, so be there for him + (folding-install)) + (folding-keep-hooked) ;set hooks if not there + (widen) + (setq folding-narrow-overlays nil) + (folding-set-local-variables) + (folding-font-lock-support) + (unwind-protect + (let ((hook-symbol (intern-soft + (concat + (symbol-name major-mode) + "-folding-hook")))) + (run-hooks 'folding-mode-hook) + (and hook-symbol + (run-hooks hook-symbol))) + (folding-set-mode-line)) + (and folding-folding-on-startup + (if (or (called-interactively-p 'interactive) + arg + inter) + (folding-whole-buffer) + (save-excursion + (folding-whole-buffer)))) + (folding-narrow-to-region nil nil t) + ;; Remove "%n" (Narrow) from the mode line + (setq mode-line-format + (mapcar + (function + (lambda (item) + (if (equal item "%n") + 'folding-narrow-placeholder item))) + mode-line-format)))) + (setq folding-mode new-folding-mode) + (if folding-mode + (easy-menu-add folding-mode-menu) + (easy-menu-remove folding-mode-menu)))) + +;;}}} +;;{{{ code: setting fold marks + +;; You think those "\\(\\)" pairs are peculiar? Me too. Emacs regexp +;; stuff has a bug; sometimes "\\(.*\\)" fails when ".*" succeeds, but +;; only in a folded file! Strange bug! Must check it out sometime. + +(defun folding-set-marks (top bottom &optional secondary) + "Set the folding top and bottom mark for the current buffer. + +Input: + + TOP The topmost fold mark. Comment start + fold begin string. + BOTTOM The bottom fold mark Comment end + fold end string. + SECONDARY Usually the comment end indicator for the mode. This + is inserted by `folding-fold-region' after the fold top mark, + and is presumed to be put after the title of the fold. + +Example: + + html-mode: + + top: \"\" + sec: \" -->\" + +Notice that the top marker needs to be closed with SECONDARY comment end string. + +Various regular expressions are set with this function, so don't set the +mark variables directly." + (set (make-local-variable 'folding-top-mark) + top) + (set (make-local-variable 'folding-bottom-mark) + bottom) + (set (make-local-variable 'folding-secondary-top-mark) + secondary) + (set (make-local-variable 'folding-top-regexp) + (concat "\\(^\\|\r+\\)[ \t]*" + (regexp-quote folding-top-mark))) + (set (make-local-variable 'folding-bottom-regexp) + (concat "\\(^\\|\r+\\)[ \t]*" + (regexp-quote folding-bottom-mark))) + (set (make-local-variable 'folding-regexp) + (concat "\\(^\\|\r\\)\\([ \t]*\\)\\(\\(" + (regexp-quote folding-top-mark) + "\\)\\|\\(" + (regexp-quote folding-bottom-mark) + "[ \t]*\\(\\)\\($\\|\r\\)\\)\\)"))) + +;;}}} +;;{{{ code: movement + +(defun folding-next-visible-heading (&optional direction) + "Move up/down fold headers. +Backward if DIRECTION is non-nil returns nil if not moved = no next marker." + (interactive) + (let* ((begin-mark (nth 0 (folding-get-mode-marks))) + case-fold-search) + (if direction + (re-search-backward (concat "^" (regexp-quote begin-mark)) nil t) + (re-search-forward (concat "^" (regexp-quote begin-mark)) nil t)))) + +(defun folding-previous-visible-heading () + "Move upward fold headers." + (interactive) + (beginning-of-line) + (folding-next-visible-heading 'backward)) + +(defun folding-find-folding-mark (&optional end-fold) + "Search backward to find beginning fold. Skips subfolds. +Optionally searches forward to find END-FOLD mark. + +Return: + + nil + point position of fold mark" + (let* (case-fold-search + (elt (folding-get-mode-marks)) + (bm (regexp-quote (nth 0 elt))) ; markers defined for mode + (em (regexp-quote (nth 1 elt))) ; markers defined for mode + (re (concat "^" bm "\\|^" em)) + (count 0) + stat + moved) + (save-excursion + (cond + (end-fold + (folding-end-of-line) + ;; We must skip over inner folds + (while (and (null moved) + (re-search-forward re nil t)) + (setq stat (folding-mark-look-at)) + (cond + ((symbolp stat) + (setq count (1- count)) + (if (< count 0) ;0 or less means no middle folds + (setq moved t))) + ((memq stat '(1 11)) ;BEG fold + (setq count (1+ count))))) ;; end while + (when moved + (forward-char -3) + (setq moved (point)))) + (t + (while (and (null moved) + (re-search-backward re nil t)) + (setq stat (folding-mark-look-at)) + (cond + ((memq stat '(1 11)) + (setq count (1- count)) + (if (< count 0) ;0 or less means no middle folds + (setq moved (point)))) + ((symbolp stat) + (setq count (1+ count))))) + (when moved ;What's the result + (forward-char 3) + (setq moved (point)))))) + moved)) + +(defun folding-pick-move () + "Pick the logical movement on fold mark. +If at the end of fold, then move to the beginning and vice versa. + +If placed over closed fold moves to the next fold. When no next +folds are visible, stops moving. + +Return: + t if moved" + (interactive) + (let* (case-fold-search + (elt (folding-get-mode-marks)) + (bm (nth 0 elt)) ; markers defined for mode + (stat (folding-mark-look-at)) + moved) + (cond + ((eq 0 stat) ;closed fold + (when (re-search-forward (concat "^" (regexp-quote bm)) nil t) + (setq moved t) + (forward-char 3))) + ((symbolp stat) ;End fold + (setq moved (folding-find-folding-mark))) + ((integerp stat) ;Beg fold + (setq moved (folding-find-folding-mark 'end-fold)))) + (if (integerp moved) + (goto-char moved)) + moved)) + +;;; Idea by Scott Evans +(defun folding-context-next-action () + "Take next action according to point and context. +If point is at: + + Begin Fold : toggle open - close + End Fold : close + inside : fold current level." + (interactive) + (let ((state (folding-mark-look-at))) + (cond + ((eq state 0) + (folding-act 'open)) + ((eq state 1) + (folding-act 'close)) + ((eq state 11) + (folding-act 'up)) + ((eq 'end state) + (folding-act 'close)) + ((eq state 'end-in) + (folding-act 'up)) + (t + (folding-act 'other))))) + +(defun folding-forward-char-1 (&optional arg) + "See `folding-forward-char-1' for ARG." + (if (eq arg 1) + ;; Do it a faster way for arg = 1. + (if (eq (following-char) ?\r) + (let ((saved (point)) + (inhibit-quit t)) + (end-of-line) + (if (not (eobp)) + (forward-char) + (goto-char saved) + (error "End of buffer"))) + ;; `forward-char' here will do its own error if (eobp). + (forward-char)) + (if (> 0 (or arg (setq arg 1))) + (folding-backward-char (- arg)) + (let (goal saved) + (while (< 0 arg) + (skip-chars-forward "^\r" (setq goal (+ (point) arg))) + (if (eq goal (point)) + (setq arg 0) + (if (eobp) + (error "End of buffer") + (setq arg (- goal 1 (point)) + saved (point)) + (let ((inhibit-quit t)) + (end-of-line) + (if (not (eobp)) + (forward-char) + (goto-char saved) + (error "End of buffer")))))))))) + +(defmacro folding-forward-char-macro () + `(defun folding-forward-char (&optional arg) + "Move point right ARG characters, skipping hidden folded regions. +Moves left if ARG is negative. On reaching end of buffer, stop and +signal error." + ,(folding-interactive-spec-p) + ;; (folding-preserve-active-region) + (folding-forward-char-1 arg))) + +(folding-forward-char-macro) + +(defun folding-backward-char-1 (&optional arg) + "See `folding-backward-char-1' for ARG." + (if (eq arg 1) + ;; Do it a faster way for arg = 1. + ;; Catch the case where we are in a hidden region, and bump into a \r. + (if (or (eq (preceding-char) ?\n) + (eq (preceding-char) ?\r)) + (let ((pos (1- (point))) + (inhibit-quit t)) + (forward-char -1) + (beginning-of-line) + (skip-chars-forward "^\r" pos)) + (forward-char -1)) + (if (> 0 (or arg (setq arg 1))) + (folding-forward-char (- arg)) + (let (goal) + (while (< 0 arg) + (skip-chars-backward "^\r\n" (max (point-min) + (setq goal (- (point) arg)))) + (if (eq goal (point)) + (setq arg 0) + (if (bobp) + (error "Beginning of buffer") + (setq arg (- (point) 1 goal) + goal (point)) + (let ((inhibit-quit t)) + (forward-char -1) + (beginning-of-line) + (skip-chars-forward "^\r" goal))))))))) + +(defmacro folding-backward-char-macro () + `(defun folding-backward-char (&optional arg) + "Move point right ARG characters, skipping hidden folded regions. +Moves left if ARG is negative. On reaching end of buffer, stop and +signal error." + ,(folding-interactive-spec-p) + ;; (folding-preserve-active-region) + (folding-backward-char-1 arg))) + +(folding-backward-char-macro) + +(defmacro folding-end-of-line-macro () + `(defun folding-end-of-line (&optional arg) + "Move point to end of current line, but before hidden folded region. +ARG is line count. + +Has the same behavior as `end-of-line', except that if the current line +ends with some hidden folded text (represented by an ellipsis), the +point is positioned just before it. This prevents the point from being +placed inside the folded text, which is not normally useful." + ,(folding-interactive-spec-p) + ;;(interactive "p") + ;; (folding-preserve-active-region) + (if (or (eq arg 1) + (not arg)) + (beginning-of-line) + ;; `forward-line' also moves point to beginning of line. + (forward-line (1- arg))) + (skip-chars-forward "^\r\n"))) + +(folding-end-of-line-macro) + +(defun folding-skip-ellipsis-backward () + "Move the point backwards out of folded text. + +If the point is inside a folded region, the cursor is displayed at the +end of the ellipsis representing the folded part. This function checks +to see if this is the case, and if so, moves the point backwards until +it is just outside the hidden region, and just before the ellipsis. + +Returns t if the point was moved, nil otherwise." + (interactive) + (let ((pos (point)) + result) + (save-excursion + (beginning-of-line) + (skip-chars-forward "^\r" pos) + (or (eq pos (point)) + (setq pos (point) + result t))) + (goto-char pos) + result)) + +;;}}} + +;;{{{ code: Moving in and out of folds + +;;{{{ folding-shift-in + +(defun folding-shift-in (&optional noerror) + "Open and enter the fold at or around the point. + +Enters the fold that the point is inside, wherever the point is inside +the fold, provided it is a valid fold with balanced top and bottom +marks. Returns nil if the fold entered contains no sub-folds, t +otherwise. If an optional argument NOERROR is non-nil, returns nil if +there are no folds to enter, instead of causing an error. + +If the point is inside a folded, hidden region (as represented by an +ellipsis), the position of the point in the buffer is preserved, and as +many folds as necessary are entered to make the surrounding text +visible. This is useful after some commands eg., search commands." + (interactive) + (labels + ((open-fold nil + (let ((data (folding-show-current-entry noerror t))) + (and data + (progn + (when folding-narrow-by-default + (setq folding-stack + (if folding-stack + (cons (cons (point-min-marker) + (point-max-marker)) + folding-stack) + '(folded))) + (folding-set-mode-line)) + (folding-narrow-to-region + (car data) + (nth 1 data))))))) + (let ((goal (point))) + (while (folding-skip-ellipsis-backward) + (beginning-of-line) + (open-fold) + (goto-char goal)) + (if folding-narrow-by-default + (open-fold) + (widen))))) + +;;}}} +;;{{{ folding-shift-out + +(defun folding-shift-out (&optional event) + "Exits the current fold with EVENT." + (interactive) + (if folding-stack + (progn + (folding-tidy-inside) + (cond + ((folding-use-overlays-p) + (folding-subst-regions + (list (overlay-end (car folding-narrow-overlays)) + (overlay-start (cdr folding-narrow-overlays))) ?\n ?\r) + ;; So point is correct in other windows. + (goto-char (overlay-end (car folding-narrow-overlays)))) + (t + (folding-subst-regions (list (point-min) (point-max)) ?\n ?\r) + ;; So point is correct in other window + (goto-char (point-min)))) + + (if (eq (car folding-stack) 'folded) + (folding-narrow-to-region nil nil t) + (folding-narrow-to-region + (marker-position (car (car folding-stack))) + (marker-position (cdr (car folding-stack))) t)) + (and (consp (car folding-stack)) + (set-marker (car (car folding-stack)) nil) + (set-marker (cdr (car folding-stack)) nil)) + (setq folding-stack (cdr folding-stack))) + (error "Outside all folds")) + (folding-set-mode-line)) + +;;}}} +;;{{{ folding-show-current-entry + +(defun folding-show-current-entry (&optional event noerror noskip) + "Opens the fold that the point is on, but does not enter it. +EVENT and optional arg NOERROR means don't signal an error if there is +no fold, just return nil. NOSKIP means don't jump out of a hidden +region first. + +Returns ((START END SUBFOLDS-P). START and END indicate the extents of +the fold that was shown. If SUBFOLDS-P is non-nil, the fold contains +subfolds." + (interactive) + (or noskip + (folding-skip-ellipsis-backward)) + (let ((point (point)) + backward + forward + start + end + subfolds-not-p) + (unwind-protect + (or (and (integerp + (car-safe (setq backward (folding-skip-folds t)))) + (integerp + (car-safe (setq forward (folding-skip-folds nil)))) + (progn + (goto-char (car forward)) + (skip-chars-forward "^\r\n") + (setq end (point)) + (skip-chars-forward "\r\n") + (not (and folding-stack (eobp)))) + (progn + (goto-char (car backward)) + (skip-chars-backward "^\r\n") + (setq start (point)) + (skip-chars-backward "\r\n") + (not (and folding-stack (bobp)))) + (progn + (setq point start) + ;; Avoid holding the list through a GC. + (setq subfolds-not-p + (not (or (cdr backward) + (cdr forward)))) + (folding-subst-regions + (append backward (nreverse forward)) + ?\r ?\n) + ;; FIXME: this should be moved to font-lock: + ;; - When fold is closed, the whole line (with code) + ;; is treated as comment + ;; - Fon-lock changes all fonts to `font-lock-comment-face' + ;; - When you again open fold, all text is in color + ;; + ;; => Font lock should stop at \r, and not use ".*" + ;; which includes \r character + ;; This is a workaround, not an efficient one + (if (or (and (boundp 'global-font-lock-mode) + global-font-lock-mode) + font-lock-mode) + (font-lock-fontify-region start end)) + (list start end (not subfolds-not-p)))) + (if noerror + nil + (error "Not on a fold"))) + (goto-char point)))) + +;;}}} +;;{{{ folding-hide-current-entry + +(defun folding-toggle-enter-exit () + "Run `folding-shift-in' or `folding-shift-out'. +This depends on current line's contents." + (interactive) + (beginning-of-line) + (let ((current-line-mark (folding-mark-look-at))) + (if (and (numberp current-line-mark) + (= current-line-mark 0)) + (folding-shift-in) + (folding-shift-out)))) + +(defun folding-toggle-show-hide () + "Run folding-show-current-entry or folding-hide-current-entry depending on current line's contents." + (interactive) + (beginning-of-line) + (let ((current-line-mark (folding-mark-look-at))) + (if (and (numberp current-line-mark) + (= current-line-mark 0)) + (folding-show-current-entry) + (folding-hide-current-entry)))) + +(defun folding-hide-current-entry (&optional event) + "Close the fold around the point using EVENT. +Undo effect of `folding-show-current-entry'." + (interactive) + (folding-skip-ellipsis-backward) + (let (start end) + (if (and (integerp (setq start (car-safe (folding-skip-folds t)))) + (integerp (setq end (car-safe (folding-skip-folds nil))))) + (if (and folding-stack + (or (eq start (point-min)) + (eq end (point-max)))) + ;;(error "Cannot hide current fold") + (folding-shift-out) + (goto-char start) + (skip-chars-backward "^\r\n") + (folding-subst-regions (list start end) ?\n ?\r)) + (error "Not on a fold")))) + +;;}}} +;;{{{ folding-show-all + +(defun folding-show-all () + "Exits all folds, to the top level." + (interactive) + (while folding-stack + (folding-shift-out))) + +;;}}} +;;{{{ folding-goto-line + +(defun folding-goto-line (line) + "Go to LINE, entering as many folds as possible." + (interactive "NGoto line: ") + (folding-show-all) + (goto-char 1) + (and (< 1 line) + (re-search-forward "[\n\C-m]" nil 0 (1- line))) + (let ((goal (point))) + (while (prog2 (beginning-of-line) + (folding-shift-in t) + (goto-char goal)))) + (folding-narrow-to-region + (and folding-narrow-by-default (point-min)) + (point-max) t)) + +;;}}} + +;;}}} +;;{{{ code: Searching for fold boundaries + +;;{{{ folding-skip-folds + +(defun folding-skip-folds (backward &optional outside) + "Skips forward through the buffer (backward if BACKWARD is non-nil) +until it finds a closing fold mark or the end of the buffer. The +point is not moved. Jumps over balanced folding-mark pairs on the way. +Returns t if the end of buffer was found in an unmatched folding-mark +pair, otherwise a list. + +If the point is actually on an fold start mark, the mark is ignored; +if it is on an end mark, the mark is noted. This decision is +reversed if BACKWARD is non-nil. If optional OUTSIDE is non-nil and +BACKWARD is nil, either mark is noted. + +The first element of the list is a position in the end of the closing +fold mark if one was found, or nil. It is followed by (END START) +pairs (flattened, not a list of pairs). The pairs indicating the +positions of folds skipped over; they are positions in the fold +marks, not necessarily at the ends of the fold marks. They are in +the opposite order to that in which they were skipped. The point is +left in a meaningless place. If going backwards, the pairs are +\(START END) pairs, as the fold marks are scanned in the opposite +order. + +Works by maintaining the position of the top and bottom marks found +so far. They are found separately using a normal string search for +the fixed part of a fold mark (because it is faster than a regexp +search if the string does not occur often outside of fold marks), +checking that it really is a proper fold mark, then considering the +earliest one found. The position of the other (if found) is +maintained to avoid an unnecessary search at the next iteration." + (let ((first-mark (if backward folding-bottom-mark folding-top-mark)) + (last-mark (if backward folding-top-mark folding-bottom-mark)) + (top-re folding-top-regexp) + (depth 0) + pairs point + temp + start + first + last + case-fold-search) + ;; Ignore trailing space? + (when nil + (when (and (stringp first-mark) + (string-match "^\\(.*[^ ]+\\) +$" first-mark)) + (setq first-mark (match-string 1 first-mark))) + (when (and (stringp last-mark) + (string-match "^\\(.*[^ ]+\\) +$" last-mark)) + (setq last-mark (match-string 1 last-mark))) + (when (and (stringp top-re) + (string-match "^\\(.*[^ ]+\\) +$" top-re)) + (setq top-re (match-string 1 top-re)))) + (save-excursion + (skip-chars-backward "^\r\n") + (unless outside + (and (eq (preceding-char) ?\r) + (forward-char -1)) + (if (looking-at top-re) + (if backward + (setq last (match-end 1)) + (skip-chars-forward "^\r\n")))) + (while (progn + ;; Find last first, prevents unnecessary searching + ;; for first. + (setq point (point)) + (or last + (while (and (if backward + (search-backward last-mark first t) + (search-forward last-mark first t)) + (progn + (setq temp (point)) + (goto-char (match-beginning 0)) + (skip-chars-backward " \t") + (and (not + (setq last + (if (eq (preceding-char) ?\r) + temp + (and (bolp) temp)))) + (goto-char temp))))) + (goto-char point)) + (or first + (while (and (if backward + (search-backward first-mark last t) + (search-forward first-mark last t)) + (progn + (setq temp (point)) + (goto-char (match-beginning 0)) + (skip-chars-backward " \t") + (and (not + (setq first + (if (eq (preceding-char) ?\r) + temp + (and (bolp) temp)))) + (goto-char temp)))))) + ;; Return value of conditional says whether to + ;; iterate again. + (if (not last) + ;; Return from this with the result. + (not (setq pairs (if first t (cons nil pairs)))) + (if (and first + (if backward + (> first last) + (< first last))) + (progn + (goto-char first) + (if (eq 0 depth) + (setq start first + first nil + depth 1) ;; non-nil value, loop again. + (setq first nil + ;; non-nil value => loop again + depth (1+ depth)))) + (goto-char last) + (if (eq 0 depth) + (not (setq pairs (cons last pairs))) + (or (< 0 (setq depth (1- depth))) + (setq pairs (cons last (cons start pairs)))) + (setq last nil) + t))))) + pairs))) + +;;}}} + +;;}}} +;;{{{ code: Functions that actually modify the buffer + +;;{{{ folding-fold-region + +(defun folding-fold-region (start end) + "Places fold mark at the beginning and end of a specified region. +The region is specified by two arguments START and END. The point is +left at a suitable place ready to insert the title of the fold. + +The fold markers are intended according to mode." + (interactive "r") + (and (< end start) + (setq start (prog1 end + (setq end start)))) + (setq end (set-marker (make-marker) end)) + (goto-char start) + (beginning-of-line) + (setq start (point)) + (insert-before-markers folding-top-mark) + ;; XEmacs latex-mode, after (tex-site), indents the whole + ;; fold 50 characters right. Don't do that. + (unless (string-match "latex" (symbol-name major-mode)) + (indent-according-to-mode)) + (let ((saved-point (point))) + (and folding-secondary-top-mark + (insert-before-markers folding-secondary-top-mark)) + (insert-before-markers ?\n) + (goto-char (marker-position end)) + (set-marker end nil) + (and (not (bolp)) + (eq 0 (forward-line)) + (eobp) + (insert ?\n)) + (insert folding-bottom-mark) + (unless (string-match "latex" (symbol-name major-mode)) + (indent-according-to-mode)) + (insert ?\n) + (setq folding-stack (if folding-stack + (cons (cons (point-min-marker) + (point-max-marker)) + folding-stack) + '(folded))) + (folding-narrow-to-region start (1- (point))) + (goto-char saved-point) + (folding-set-mode-line)) + (save-excursion (folding-tidy-inside))) + +;;}}} +;;{{{ folding-tidy-inside + +;; Note to self: The long looking code for checking and modifying those +;; blank lines is to make sure the text isn't modified unnecessarily. +;; Don't remove it again! + +(defun folding-tidy-inside () + "Add or remove blank lines at the top and bottom of the current fold. +Also adds fold marks at the top and bottom (after asking), if they are not +there already. The amount of space left depends on the variable +`folding-internal-margins', which is one by default." + (interactive) + (if buffer-read-only nil + (let () +;;; (top-re (if (string-match "^\\(.*\\) $" folding-top-mark) +;;; (match-string 1 folding-top-mark) +;;; folding-top-mark)) + (if (folding-use-overlays-p) + (goto-char (- (overlay-end (car folding-narrow-overlays)) 1)) + (goto-char (point-min))) + (and (eolp) + (progn (skip-chars-forward "\n\t ") + (delete-region (point-min) (point)))) + (and (if (let (case-fold-search) (folding-mark-look-at-top-mark-p)) + (progn (forward-line 1) + (and (eobp) (insert ?\n)) + t) + (and (y-or-n-p "Insert missing folding-top-mark? ") + (progn (insert (concat folding-top-mark + "" + (or folding-secondary-top-mark "") + "\n")) + t))) + folding-internal-margins + (<= 0 folding-internal-margins) + (let* ((p1 (point)) + (p2 (progn (skip-chars-forward "\n") (point))) + (p3 (progn (skip-chars-forward "\n\t ") + (skip-chars-backward "\t " p2) (point)))) + (if (eq p2 p3) + (or (eq p2 (setq p3 (+ p1 folding-internal-margins))) + (if (< p2 p3) + (newline (- p3 p2)) + (delete-region p3 p2))) + (delete-region p1 p3) + (or (eq 0 folding-internal-margins) + (newline folding-internal-margins))))) + (if (folding-use-overlays-p) + (goto-char (overlay-start (cdr folding-narrow-overlays))) + (goto-char (point-max))) + (and (bolp) + (progn (skip-chars-backward "\n") + (delete-region (point) (point-max)))) + (beginning-of-line) + (and (or (let (case-fold-search) (folding-mark-look-at-bottom-mark-p)) + (progn (goto-char (point-max)) nil) + (and (y-or-n-p "Insert missing folding-bottom-mark? ") + (progn + (insert (concat "\n" folding-bottom-mark)) + (beginning-of-line) + t))) + folding-internal-margins + (<= 0 folding-internal-margins) + (let* ((p1 (point)) + (p2 (progn (skip-chars-backward "\n") (point))) + (p3 (progn (skip-chars-backward "\n\t ") + (skip-chars-forward "\t " p2) (point)))) + (if (eq p2 p3) + (or (eq p2 (setq p3 (- p1 1 folding-internal-margins))) + (if (> p2 p3) + (newline (- p2 p3)) + (delete-region p2 p3))) + (delete-region p3 p1) + (newline (1+ folding-internal-margins)))))))) + +;;}}} + +;;}}} +;;{{{ code: Operations on the whole buffer + +;;{{{ folding-whole-buffer + +(defun folding-whole-buffer () + "Folds every fold in the current buffer. +Fails if the fold markers are not balanced correctly. + +If the buffer is being viewed in a fold, folds are repeatedly exited to +get to the top level first (this allows the folds to be tidied on the +way out). The buffer modification flag is not affected, and this +function will work on read-only buffers." + + (interactive) + (message "Folding buffer...") + (let ((narrow-min (point-min)) + (narrow-max (point-max)) + folding-list) + (save-excursion + (widen) + (goto-char 1) + (setq folding-list (folding-skip-folds nil t)) + (narrow-to-region narrow-min narrow-max) + (and (eq t folding-list) + (error + "Cannot fold whole buffer -- unmatched begin-fold mark `%s' `%s'" + (current-buffer) + folding-top-mark)) + (and (integerp (car folding-list)) + (error + "Cannot fold whole buffer -- extraneous end-fold mark `%s' `%s'" + (current-buffer) + folding-bottom-mark)) + (folding-show-all) + (widen) + (goto-char 1) + ;; Do the modifications forwards. + (folding-subst-regions (nreverse (cdr folding-list)) ?\n ?\r)) + (beginning-of-line) + (folding-narrow-to-region nil nil t) + (message "Folding buffer... done"))) + +;;}}} +;;{{{ folding-open-buffer + +(defun folding-open-buffer () + "Unfolds the entire buffer, leaving the point where it is. +Does not affect the buffer-modified flag, and can be used on read-only +buffers." + (interactive) + (message "Unfolding buffer...") + (folding-clear-stack) + (folding-set-mode-line) + (unwind-protect + (progn + (widen) + (folding-subst-regions (list 1 (point-max)) ?\r ?\n)) + (folding-narrow-to-region nil nil t)) + (message "Unfolding buffer... done")) + +;;}}} +;;{{{ folding-convert-buffer-for-printing + +(defun folding-convert-buffer-for-printing (&optional buffer pre-title post-title pad) + "Remove folds from a buffer, for printing. + +It copies the contents of the (hopefully) folded buffer BUFFER into a +buffer called `*Unfolded: *', removing all of the fold +marks. It keeps the titles of the folds, however, and numbers them. +Subfolds are numbered in the form 5.1, 5.2, 5.3 etc., and the titles are +indented to eleven characters. + +It accepts four arguments. BUFFER is the name of the buffer to be +operated on, or a buffer. nil means use the current buffer. PRE-TITLE +is the text to go before the replacement fold titles, POST-TITLE is the +text to go afterwards. Finally, if PAD is non-nil, the titles are all +indented to the same column, which is eleven plus the length of +PRE-TITLE. Otherwise just one space is placed between the number and +the title." + (interactive (list (read-buffer "Remove folds from buffer: " + (buffer-name) + t) + (read-string "String to go before enumerated titles: ") + (read-string "String to go after enumerated titles: ") + (y-or-n-p "Pad section numbers with spaces? "))) + (set-buffer (setq buffer (get-buffer buffer))) + (setq pre-title (or pre-title "") + post-title (or post-title "")) + (or folding-mode + (error "Must be in Folding mode before removing folds")) + (let* ((new-buffer (get-buffer-create (concat "*Unfolded: " + (buffer-name buffer) + "*"))) + (section-list '(1)) + (section-prefix-list '("")) + + (secondary-mark-length (length folding-secondary-top-mark)) + + (secondary-mark folding-secondary-top-mark) + (mode major-mode) + + ;; [jari] Aug 14 1997 + ;; Regexp doesn't allow "footer text" like, so we add one more + ;; regexp to loosen the end criteria + ;; + ;; {{{ Subsubsection 1 + ;; }}} Subsubsection 1 + ;; + ;; was: (regexp folding-regexp) + ;; + (regexp + (concat "\\(^\\|\r\\)\\([ \t]*\\)\\(\\(" + (regexp-quote folding-top-mark) + "\\)\\|\\(" + (regexp-quote folding-bottom-mark) + "[ \t]*.*\\(\\)\\($\\|\r\\)\\)\\)")) + title + prefix) + ;; was obsolete function: (buffer-flush-undo new-buffer) + (buffer-disable-undo new-buffer) + (save-excursion + (set-buffer new-buffer) + (delete-region (point-min) + (point-max))) + (save-restriction + (widen) + (copy-to-buffer new-buffer (point-min) (point-max))) + (display-buffer new-buffer t) + (set-buffer new-buffer) + (subst-char-in-region (point-min) (point-max) ?\r ?\n) + (funcall mode) + (while (re-search-forward regexp nil t) + (if (match-beginning 4) + (progn + (goto-char (match-end 4)) + + ;; - Move after start fold and read the title from there + ;; - Then move back and kill the fold mark + ;; + (setq title + (buffer-substring (point) + (progn (end-of-line) + (point)))) + (delete-region (save-excursion + (goto-char (match-beginning 4)) + (skip-chars-backward "\n\r") + (point)) + (progn + (skip-chars-forward "\n\r") + (point))) + (and (<= secondary-mark-length + (length title)) + (string-equal secondary-mark + (substring title + (- secondary-mark-length))) + (setq title (substring title + 0 + (- secondary-mark-length)))) + (setq section-prefix-list + (cons (setq prefix (concat (car section-prefix-list) + (int-to-string (car section-list)) + ".")) + section-prefix-list)) + (or (cdr section-list) + (insert ?\n)) + (setq section-list (cons 1 + (cons (1+ (car section-list)) + (cdr section-list)))) + (setq title (concat prefix + (if pad + (make-string + (max 2 (- 8 (length prefix))) ? ) + " ") + title)) + (message "Reformatting: %s%s%s" + pre-title + title + post-title) + (insert "\n\n" + pre-title + title + post-title + "\n\n")) + (goto-char (match-beginning 5)) + (or (setq section-list (cdr section-list)) + (error "Too many bottom-of-fold marks")) + + (setq section-prefix-list (cdr section-prefix-list)) + (delete-region (point) + (progn + (forward-line 1) + (point))))) + (and (cdr section-list) + (error + "Too many top-of-fold marks -- reached end of file prematurely")) + (goto-char (point-min)) + (buffer-enable-undo) + (set-buffer-modified-p nil) + (message "All folds reformatted."))) + +;;}}} +;;}}} + +;;{{{ code: Standard fold marks for various major modes + +;;{{{ A function to set default marks, `folding-add-to-marks-list' + +(defun folding-add-to-marks-list (mode top bottom + &optional secondary noforce message) + "Add/set fold mark list for a particular major mode. +When called interactively, asks for a `major-mode' name, and for +fold marks to be used in that mode. It adds the new set to +`folding-mode-marks-alist', and if the mode name is the same as the current +major mode for the current buffer, the marks in use are also changed. + +If called non-interactively, arguments are MODE, TOP, BOTTOM and +SECONDARY. MODE is the symbol for the major mode for which marks are +being set. TOP, BOTTOM and SECONDARY are strings, the three fold marks +to be used. SECONDARY may be nil (as opposed to the empty string), but +the other two must be non-empty strings, and is an optional argument. + +Two other optional arguments are NOFORCE, meaning do not change the +marks if marks are already set for the specified mode if non-nil, and +MESSAGE, which causes a message to be displayed if it is non-nil. This +is also the message displayed if the function is called interactively. + +To set default fold marks for a particular mode, put something like the +following in your .emacs: + +\(folding-add-to-marks-list 'major-mode \"(** {{{ \" \"(** }}} **)\" \" **)\") + +Look at the variable `folding-mode-marks-alist' to see what default settings +already apply. + +`folding-set-marks' can be used to set the fold marks in use in the current +buffer without affecting the default value for a particular mode." + (interactive + (let* ((mode (completing-read + (concat "Add fold marks for major mode (" + (symbol-name major-mode) + "): ") + obarray + (function + (lambda (arg) + (and (commandp arg) + (string-match "-mode\\'" + (symbol-name arg))))) + t)) + (mode (if (equal mode "") + major-mode + (intern mode))) + (object (assq mode folding-mode-marks-alist)) + (old-top (and object + (nth 1 object))) + top + (old-bottom (and object + (nth 2 object))) + bottom + (secondary (and object + (nth 3 object))) + (prompt "Top fold marker: ")) + (and (equal secondary "") + (setq secondary nil)) + (while (not top) + (setq top (read-string prompt (or old-top "{{{ "))) + (and (equal top "") + (setq top nil))) + (setq prompt (concat prompt + top + ", Bottom marker: ")) + (while (not bottom) + (setq bottom (read-string prompt (or old-bottom "}}}"))) + (and (equal bottom "") + (setq bottom nil))) + (setq prompt (concat prompt + bottom + (if secondary + ", Secondary marker: " + ", Secondary marker (none): ")) + secondary (read-string prompt secondary)) + (and (equal secondary "") + (setq secondary nil)) + (list mode top bottom secondary nil t))) + (let ((object (assq mode folding-mode-marks-alist))) + (if (and object + noforce + message) + (message "Fold markers for `%s' are already set." + (symbol-name mode)) + (if object + (or noforce + (setcdr object (if secondary + (list top bottom secondary) + (list top bottom)))) + (setq folding-mode-marks-alist + (cons (if secondary + (list mode top bottom secondary) + (list mode top bottom)) + folding-mode-marks-alist))) + (and message + (message "Set fold marks for `%s' to \"%s\" and \"%s\"." + (symbol-name mode) + (if secondary + (concat top "name" secondary) + (concat top "name")) + bottom) + (and (eq major-mode mode) + (folding-set-marks top bottom secondary)))))) + +;;}}} +;;{{{ Set some useful default fold marks + +(folding-add-to-marks-list 'ada-mode "-- {{{" "-- }}}" nil t) +(folding-add-to-marks-list 'asm-mode "; {{{" "; }}}" nil t) +(folding-add-to-marks-list 'awk-mode "# {{{" "# }}}" nil t) +(folding-add-to-marks-list 'Bison-mode "/* {{{" "/* }}} */" " */" t) +(folding-add-to-marks-list 'LaTeX-mode "%{{{" "%}}}" nil t) +(folding-add-to-marks-list 'TeX-mode "%{{{" "%}}}" nil t) +(folding-add-to-marks-list 'bibtex-mode "%{{{" "%}}} */" nil t) +(folding-add-to-marks-list 'bison-mode "/* {{{" "/* }}} */" " */" t) +(folding-add-to-marks-list 'c++-mode "// {{{" "// }}}" nil t) +(folding-add-to-marks-list 'c-mode "/* {{{" "/* }}} */" " */" t) +(folding-add-to-marks-list 'dcl-mode "! {{{" "! }}}" nil t) +(folding-add-to-marks-list 'change-log-mode "{{{" "}}}" nil t) +(folding-add-to-marks-list 'cperl-mode "# {{{" "# }}}" nil t) +(folding-add-to-marks-list 'emacs-lisp-mode ";;{{{" ";;}}}" nil t) +(folding-add-to-marks-list 'erlang-mode "%%{{{" "%%}}}" nil t) +(folding-add-to-marks-list 'finder-mode "{{{" "}}}" nil t) +(folding-add-to-marks-list 'fortran-mode "! {{{" "! }}}" nil t) +(folding-add-to-marks-list 'f90-mode "! {{{" "! }}}" nil t) +(folding-add-to-marks-list 'generic-mode ";# " ";\$" nil t) +(folding-add-to-marks-list 'gofer-mode "-- {{{" "-- }}}" nil t) +(folding-add-to-marks-list 'html-mode "" " -->" t) +(folding-add-to-marks-list 'icon-mode "# {{{" "# }}}" nil t) +(folding-add-to-marks-list 'indented-text-mode "{{{" "}}}" nil t) +(folding-add-to-marks-list 'java-mode "// {{{" "// }}}" nil t) +(folding-add-to-marks-list 'javascript-mode "// {{{" "// }}}" nil t) +(folding-add-to-marks-list 'jde-mode "// {{{" "// }}}" nil t) +(folding-add-to-marks-list 'ksh-mode "# {{{" "# }}}" nil t) +(folding-add-to-marks-list 'latex-mode "%{{{" "%}}}" nil t) +(folding-add-to-marks-list 'lisp-interaction-mode ";;{{{" ";;}}}" nil t) +(folding-add-to-marks-list 'lisp-mode ";;{{{" ";;}}}" nil t) +(folding-add-to-marks-list 'm4-mode "# {{{" "# }}}" nil t) +(folding-add-to-marks-list 'makefile-mode "# {{{" "# }}}" nil t) +(folding-add-to-marks-list 'matlab-mode "%%%{{{" "%%%}}}" nil t) +(folding-add-to-marks-list 'meta-mode "% {{{" "% }}}" nil t) +(folding-add-to-marks-list 'ml-mode "(* {{{" "(* }}} *)" " *)" t) +(folding-add-to-marks-list 'modula-2-mode "(* {{{" "(* }}} *)" " *)" t) +(folding-add-to-marks-list 'nroff-mode "\\\\ {{{" "\\\\ }}}" nil t) +(folding-add-to-marks-list 'occam-mode "-- {{{" "-- }}}" nil t) +(folding-add-to-marks-list 'orwell-mode "{{{" "}}}" nil t) +(folding-add-to-marks-list 'pascal-mode "{ ((( " "{ ))) }" " }" t) +(folding-add-to-marks-list 'php-mode "// {{{" "// }}}" nil t) +(folding-add-to-marks-list 'perl-mode "# {{{" "# }}}" nil t) +(folding-add-to-marks-list 'plain-TeX-mode "%{{{" "%}}}" nil t) +(folding-add-to-marks-list 'plain-tex-mode "%{{{" "%}}}" nil t) +(folding-add-to-marks-list 'prolog-mode "% {{{" "% }}}" nil t) +(folding-add-to-marks-list 'python-mode "# {{{" "# }}}" nil t) +(folding-add-to-marks-list 'rexx-mode "/* {{{" "/* }}} */" " */" t) +(folding-add-to-marks-list 'sh-mode "# {{{" "# }}}" nil t) +(folding-add-to-marks-list 'sh-script-mode "# {{{" "# }}}" nil t) +(folding-add-to-marks-list 'shellscript-mode "# {{{" "# }}}" nil t) +(folding-add-to-marks-list 'sgml-mode "" " -->" t) +(folding-add-to-marks-list 'simula-mode "! {{{" "! }}}" nil t) +(folding-add-to-marks-list 'sml-mode "(* {{{" "(* }}} *)" " *)" t) +(folding-add-to-marks-list 'sql-mode "-- {{{" "-- }}}" nil t) +(folding-add-to-marks-list 'tcl-mode "#{{{" "#}}}" nil t) +(folding-add-to-marks-list 'tex-mode "%{{{" "%}}}" nil t) +(folding-add-to-marks-list 'texinfo-mode "@c {{{" "@c {{{endfold}}}" " }}}" t) +(folding-add-to-marks-list 'text-mode "{{{" "}}}" nil t) +(folding-add-to-marks-list 'vhdl-mode "# {{{" "# }}}" nil t) +(folding-add-to-marks-list 'xerl-mode "%%{{{" "%%}}}" nil t) +(folding-add-to-marks-list 'xrdb-mode "! {{{" "! }}}" nil t) + +;; heavy shell-perl-awk programmer in fundamental-mode need # prefix... + +(folding-add-to-marks-list 'fundamental-mode "# {{{" "# }}}" nil t) + +;;}}} + +;;}}} + +;;{{{ code: Gross, crufty hacks that seem necessary + +;; ---------------------------------------------------------------------- +;; The functions here have been tested with Emacs 18.55, Emacs 18.58, +;; Epoch 4.0p2 (based on Emacs 18.58) and XEmacs 19.6. + +;; Note that XEmacs 19.6 can't do selective-display, and its +;; "invisible extents" don't work either, so Folding mode just won't +;; work with that version. + +;; They shouldn't do the wrong thing with later versions of Emacs, but +;; they might not have the special effects either. They may appear to +;; be excessive; that is not the case. All of the peculiar things these +;; functions do is done to avoid some side-effect of Emacs' internal +;; logic that I have met. Some of them work around bugs or unfortunate +;; (lack of) features in Emacs. In most cases, it would be better to +;; move this into the Emacs C code. + +;; Folding mode is designed to be simple to cooperate with as many +;; things as possible. These functions go against that principle at the +;; coding level, but make life for the user bearable. + +;;{{{ folding-subst-regions + +;; Substitute newlines for carriage returns or vice versa. +;; Avoid excessive file locking. + +;; Substitutes characters in the buffer, even in a read-only buffer. +;; Takes LIST, a list of regions specified as sequence in the form +;; (START1 END1 START2 END2 ...). In every region specified by each +;; pair, substitutes each occurence of character FIND by REPLACE. + +;; The buffer-modified flag is not affected, undo information is not +;; kept for the change, and the function works on read-only files. This +;; function is much more efficient called with a long sequence than +;; called for each region in the sequence. + +;; If the buffer is not modified when the function is called, the +;; modified-flag is set before performing all the substitutions, and +;; locking is temporarily disabled. This prevents Emacs from trying to +;; make then delete a lock file for *every* substitution, which slows +;; folding considerably, especially on a slow networked filesystem. +;; Without this, on my system, folding files on startup (and reading +;; other peoples' folded files) takes about five times longer. Emacs +;; still locks the file once for this call under those circumstances; I +;; can't think of a way around that, but it isn't really a problem. + +;; I consider these problems to be a bug in `subst-char-in-region'. + +(defun folding-subst-regions (list find replace) + "Substitute \\r and \\n using LIST FIND REPLACE." + (let ((buffer-read-only buffer-read-only) ;; Protect read-only flag. + (modified (buffer-modified-p)) + (font-lock-mode nil) + (lazy-lock-mode nil) + (overlay-p (folding-use-overlays-p)) + (ask1 (symbol-function 'ask-user-about-supersession-threat)) + (ask2 (symbol-function 'ask-user-about-lock))) + (if lazy-lock-mode ;; no-op: Byte compiler silencer + (setq lazy-lock-mode t)) + (unwind-protect + (progn + (setq buffer-read-only nil) + (or modified + (progn + (fset 'ask-user-about-supersession-threat + '(lambda (&rest x) nil)) + (fset 'ask-user-about-lock + '(lambda (&rest x) nil)) + (set-buffer-modified-p t))) ; Prevent file locking in the loop + (while list + (if overlay-p + (folding-flag-region (car list) (nth 1 list) (eq find ?\n)) + (subst-char-in-region (car list) (nth 1 list) find replace t)) + (setq list (cdr (cdr list))))) + ;; buffer-read-only is restored by the let. + ;; Don't want to change MODIFF time if it was modified before. + (or modified + (unwind-protect + (set-buffer-modified-p nil) + (fset 'ask-user-about-supersession-threat ask1) + (fset 'ask-user-about-lock ask2)))))) + +;;}}} +;;{{{ folding-narrow-to-region + +;; Narrow to region, without surprising displays. + +;; Similar to `narrow-to-region', but also adjusts window-start to be +;; the start of the narrowed region. If an optional argument CENTRE is +;; non-nil, the window-start is positioned to leave the point at the +;; centre of the window, like `recenter'. START may be nil, in which +;; case the function acts more like `widen'. + +;; Actually, all the window-starts for every window displaying the +;; buffer, as well as the last_window_start for the buffer are set. The +;; points in every window are set to the point in the current buffer. +;; All this logic is necessary to prevent the display getting really +;; weird occasionally, even if there is only one window. Try making +;; this function like normal `narrow-to-region' with a touch of +;; `recenter', then moving around lots of folds in a buffer displayed in +;; several windows. You'll see what I mean. + +;; last_window_start is set by making sure that the selected window is +;; displaying the current buffer, then setting the window-start, then +;; making the selected window display another buffer (which sets +;; last_window_start), then setting the selected window to redisplay the +;; buffer it displayed originally. + +;; Note that whenever window-start is set, the point cannot be moved +;; outside the displayed area until after a proper redisplay. If this +;; is possible, centre the display on the point. + +;; In Emacs 19; Epoch or XEmacs, searches all screens for all +;; windows. In Emacs 19, they are called "frames". + +(defun folding-narrow-to-region (&optional start end centre) + "Narrow to region START END, possibly CENTRE." + (let* ((the-window (selected-window)) + (selected-buffer (window-buffer the-window)) + (window-ring the-window) + (window the-window) + (point (point)) + (buffer (current-buffer)) + temp) + (unwind-protect + (progn + (unwind-protect + (progn + (if (folding-use-overlays-p) + (if start + (folding-narrow-aux start end t) + (folding-narrow-aux nil nil nil)) + (if start + (narrow-to-region start end) + (widen))) + + (setq point (point)) + (set-window-buffer window buffer) + + (while (progn + (and (eq buffer (window-buffer window)) + (if centre + (progn + (select-window window) + (goto-char point) + (vertical-motion + (- (lsh (window-height window) -1))) + (set-window-start window (point)) + (set-window-point window point)) + (set-window-start window (or start 1)) + (set-window-point window point))) + + (not (eq (setq window (next-window window nil t)) + window-ring))))) + nil ;; epoch screen + (select-window the-window)) ;; unwind-protect INNER + ;; Set last_window_start. + (unwind-protect + (if (not (eq buffer selected-buffer)) + (set-window-buffer the-window selected-buffer) + (if (get-buffer "*scratch*") + (set-window-buffer the-window (get-buffer "*scratch*")) + (set-window-buffer + the-window (setq temp (generate-new-buffer " *temp*")))) + (set-window-buffer the-window buffer)) + (and temp + (kill-buffer temp)))) + ;; Undo this side-effect of set-window-buffer. + (set-buffer buffer) + (goto-char (point))))) + +;;}}} + +;;}}} + +;;{{{ code: folding-end-mode-quickly + +(defun folding-end-mode-quickly () + "Replace all ^M's with linefeeds and widen a folded buffer. +Only has any effect if Folding mode is active. + +This should not in general be used for anything. It is used when changing +major modes, by being placed in kill-mode-tidy-alist, to tidy the buffer +slightly. It is similar to `(folding-mode 0)', except that it does not +restore saved keymaps etc. Repeat: Do not use this function. Its +behaviour is liable to change." + (and (boundp 'folding-mode) + (assq 'folding-mode + (buffer-local-variables)) + folding-mode + (progn + (if (folding-use-overlays-p) + (folding-narrow-to-region nil nil) + (widen)) + (folding-clear-stack) + (folding-subst-regions (list 1 (point-max)) ?\r ?\n)))) + +;;{{{ folding-eval-current-buffer-open-folds + +(defun folding-eval-current-buffer-open-folds (&optional printflag) + "Evaluate all of a folded buffer as Lisp code. +Unlike `eval-current-buffer', this function will evaluate all of a +buffer, even if it is folded. It will also work correctly on non-folded +buffers, so is a good candidate for being bound to a key if you program +in Emacs-Lisp. + +It works by making a copy of the current buffer in another buffer, +unfolding it and evaluating it. It then deletes the copy. + +Programs can pass argument PRINTFLAG which controls printing of output: +nil means discard it; anything else is stream for print." + (interactive) + (if (or (and (boundp 'folding-mode) + folding-mode)) + (let ((temp-buffer + (generate-new-buffer (buffer-name)))) + (message "Evaluating unfolded buffer...") + (save-restriction + (widen) + (copy-to-buffer temp-buffer 1 (point-max))) + (set-buffer temp-buffer) + (subst-char-in-region 1 (point-max) ?\r ?\n) + (let ((real-message-def (symbol-function 'message)) + (suppress-eval-message)) + (fset 'message + (function + (lambda (&rest args) + (setq suppress-eval-message t) + (fset 'message real-message-def) + (apply 'message args)))) + (unwind-protect + (eval-current-buffer printflag) + (fset 'message real-message-def) + (kill-buffer temp-buffer)) + (or suppress-eval-message + (message "Evaluating unfolded buffer... Done")))) + (eval-current-buffer printflag))) + +;;}}} + +;;}}} + +;;{{{ code: ISearch support, walks in and out of folds + +;; This used to be a package of it's own. +;; Requires Emacs 19 or XEmacs. Does not work under Emacs 18. + +;;{{{ Variables + +(defcustom folding-isearch-install t + "*When non-nil, the isearch commands will handle folds." + :type 'boolean + :group 'folding) + +(defvar folding-isearch-stack nil + "Temporary storage for `folding-stack' during isearch.") + +;; Lists of isearch commands to replace + +;; These do normal searching. + +(defvar folding-isearch-normal-cmds + '(isearch-repeat-forward + isearch-repeat-backward + isearch-toggle-regexp + isearch-toggle-case-fold + isearch-delete-char + isearch-abort + isearch-quote-char + isearch-other-control-char + isearch-other-meta-char + isearch-return-char + isearch-exit + isearch-printing-char + isearch-whitespace-chars + isearch-yank-word + isearch-yank-line + isearch-yank-kill + isearch-*-char + isearch-\|-char + isearch-mode-help + isearch-yank-x-selection + isearch-yank-x-clipboard) + "List if isearch commands doing normal search.") + +;; Enables the user to edit the search string + +;; Missing, present in XEmacs isearch-mode.el. Not necessary? +;; isearch-ring-advance-edit, isearch-ring-retreat-edit, isearch-complete-edit +;; isearch-nonincremental-exit-minibuffer, isearch-yank-x-selection, +;; isearch-yank-x-clipboard + +(defvar folding-isearch-edit-enter-cmds + '(isearch-edit-string + isearch-ring-advance + isearch-ring-retreat + isearch-complete) ; (Could also stay in search mode!) + "List of isearch commands which enters search string edit.") + +;; Continues searching after editing. + +(defvar folding-isearch-edit-exit-cmds + '(isearch-forward-exit-minibuffer ; Exits edit + isearch-reverse-exit-minibuffer + isearch-nonincremental-exit-minibuffer) + "List of isearch commands which exits search string edit.") + +;;}}} +;;{{{ Keymaps (an Isearch hook) + +(defvar folding-isearch-mode-map nil + "Modified copy of the isearch keymap.") + +;; Create local copies of the keymaps. The `isearch-mode-map' is +;; copied to `folding-isearch-mode-map' while `minibuffer-local-isearch-map' +;; is made local. (Its name is used explicitly.) +;; +;; Note: This is called every time the search is started. + +(defun folding-isearch-hook-function () + "Update the isearch keymaps for usage with folding mode." + (if (and (boundp 'folding-mode) folding-mode) + (let ((cmds (append folding-isearch-normal-cmds + folding-isearch-edit-enter-cmds + folding-isearch-edit-exit-cmds))) + (setq folding-isearch-mode-map (copy-keymap isearch-mode-map)) + (make-local-variable 'minibuffer-local-isearch-map) + ;; Make sure the destructive operations below doesn't alter + ;; the global instance of the map. + (setq minibuffer-local-isearch-map + (copy-keymap minibuffer-local-isearch-map)) + (setq folding-isearch-stack folding-stack) + (while cmds + (substitute-key-definition + (car cmds) + (intern (concat "folding-" (symbol-name (car cmds)))) + folding-isearch-mode-map) + (substitute-key-definition + (car cmds) + (intern (concat "folding-" (symbol-name (car cmds)))) + minibuffer-local-isearch-map) + (setq cmds (cdr cmds))) + ;; Install our keymap + (cond + (folding-xemacs-p + (let ((f 'set-keymap-name)) + (funcall f folding-isearch-mode-map 'folding-isearch-mode-map)) + ;; Later version of XEmacs (21.2+) use overriding-local-map + ;; for isearch keymap rather than fiddling with + ;; minor-mode-map-alist. This is so isearch keymaps take + ;; precedence over extent-local keymaps. We will support + ;; both ways here. Keymaps will be restored as side-effect + ;; of isearch-abort and isearch-quit + (cond + ;; if overriding-local-map is in use + ((and (boundp 'overriding-local-map) overriding-local-map) + (set-keymap-parent folding-isearch-mode-map overriding-local-map) + (setq overriding-local-map folding-isearch-mode-map)) + ;; otherwise fiddle with minor-mode-map-alist + (t + (setq minor-mode-map-alist + (cons (cons 'isearch-mode folding-isearch-mode-map) + (delq (assoc 'isearch-mode minor-mode-map-alist) + minor-mode-map-alist)))))) + ((boundp 'overriding-terminal-local-map) + (funcall (symbol-function 'set) + 'overriding-terminal-local-map folding-isearch-mode-map)) + ((boundp 'overriding-local-map) + (setq overriding-local-map folding-isearch-mode-map)))))) + +;; Undoes the `folding-isearch-hook-function' function. + +(defun folding-isearch-end-hook-function () + "Actions to perform at the end of isearch in folding mode." + (when (and (boundp 'folding-mode) folding-mode) + (kill-local-variable 'minibuffer-local-isearch-map) + (setq folding-stack folding-isearch-stack))) + +(when folding-isearch-install + (add-hook 'isearch-mode-hook 'folding-isearch-hook-function) + (add-hook 'isearch-mode-end-hook 'folding-isearch-end-hook-function)) + +;;}}} +;;{{{ Normal search routines + +;; Generate the replacement functions of the form: +;; (defun folding-isearch-repeat-forward () +;; (interactive) +;; (folding-isearch-general 'isearch-repeat-forward)) + +(let ((cmds folding-isearch-normal-cmds)) + (while cmds + (eval + `(defun ,(intern (concat "folding-" (symbol-name (car cmds)))) + nil + "Automatically generated" + (interactive) + (folding-isearch-general (quote ,(car cmds))))) + (setq cmds (cdr cmds)))) + +;; The HEART! Executes command and updates the foldings. +;; This is capable of detecting a `quit'. + +(defun folding-isearch-general (function) + "Execute isearch command FUNCTION and adjusts the folding." + (let* ((quit-isearch nil) + (area-beg (point-min)) + (area-end (point-max)) + pos) + (cond + (t + (save-restriction + (widen) + (condition-case nil + (funcall function) + (quit (setq quit-isearch t))) + (setq pos (point))) + ;; Situation + ;; o user has folded buffer + ;; o He manually narrows, say to function ! + ;; --> there is no fold marks at the beg/end --> this is not a fold + (condition-case nil + ;; "current mode has no fold marks..." + (folding-region-has-folding-marks-p area-beg area-end) + (error (setq quit-isearch t))) + (folding-goto-char pos))) + (if quit-isearch + (signal 'quit '(isearch))))) + +;;}}} +;;{{{ Edit search string support + +(defvar folding-isearch-current-buffer nil + "The buffer we are editing, so we can widen it when in minibuffer.") + +;; Functions which enters edit mode. + +(defun folding-isearch-edit-string () + "Replace `isearch-edit-string' when in `folding-mode'." + (interactive) + (folding-isearch-start-edit 'isearch-edit-string)) + +(defun folding-isearch-ring-advance () + "Replace `isearch-ring-advance' when in `folding-mode'." + (interactive) + (folding-isearch-start-edit 'isearch-ring-advance)) + +(defun folding-isearch-ring-retreat () + "Replace `isearch-ring-retreat' when in `folding-mode'." + (interactive) + (folding-isearch-start-edit 'isearch-ring-retreat)) + +(defun folding-isearch-complete () + "Replace `isearch-complete' when in `folding-mode'." + (interactive) + (folding-isearch-start-edit 'isearch-complete)) + +;; Start and wait for editing. When (funcall fnk) returns +;; we are back in interactive search mode. +;; +;; Store match data! + +(defun folding-isearch-start-edit (function) + "Edit with function FUNCTION." + (let (pos) + (setq folding-isearch-current-buffer (current-buffer)) + (save-restriction + (funcall function) + ;; Here, we are widened, by folding-isearch-*-exit-minibuffer. + (setq pos (point))) + (folding-goto-char pos))) + +;; Functions which exits edit mode. + +;; The `widen' below will be caught by the `save-restriction' above, thus +;; this will not cripple `folding-stack'. + +(defun folding-isearch-forward-exit-minibuffer () + "Replace `isearch-forward-exit-minibuffer' when in `folding-mode'." + (interactive) + ;; Make sure we can continue searching outside narrowing. + (save-excursion + (set-buffer folding-isearch-current-buffer) + (widen)) + (isearch-forward-exit-minibuffer)) + +(defun folding-isearch-reverse-exit-minibuffer () + "Replace `isearch-reverse-exit-minibuffer' when in `folding-mode'." + (interactive) + ;; Make sure we can continue searching outside narrowing. + (save-excursion + (set-buffer folding-isearch-current-buffer) + (widen)) + (isearch-reverse-exit-minibuffer)) + +(defun folding-isearch-nonincremental-exit-minibuffer () + "Replace `isearch-reverse-exit-minibuffer' when in `folding-mode'." + (interactive) + ;; Make sure we can continue searching outside narrowing. + (save-excursion + (set-buffer folding-isearch-current-buffer) + (widen)) + (isearch-nonincremental-exit-minibuffer)) + +;;}}} +;;{{{ Special XEmacs support + +;; In XEmacs, all isearch commands must have the property `isearch-command'. + +(if folding-xemacs-p + (let ((cmds (append folding-isearch-normal-cmds + folding-isearch-edit-enter-cmds + folding-isearch-edit-exit-cmds))) + (while cmds + (put (intern (concat "folding-" (symbol-name (car cmds)))) + 'isearch-command t) + (setq cmds (cdr cmds))))) + +;;}}} +;;{{{ General purpose function. + +(defun folding-goto-char (pos) + "Goto character POS, changing fold if necessary." + ;; Make sure POS is inside the visible area of the buffer. + (goto-char pos) + (if (eq pos (point)) ; Point inside narrowed area? + nil + (folding-show-all) ; Fold everything and goto top. + (goto-char pos)) + ;; Enter if point is folded. + (if (folding-point-folded-p pos) + (progn + (folding-shift-in) ; folding-shift-in can change the pos. + (setq folding-isearch-stack folding-stack) + (setq folding-stack '(folded)) + (goto-char pos)))) + +(defun folding-point-folded-p (pos) + "Non-nil when POS is not visible." + (if (folding-use-overlays-p) + (let ((overlays (overlays-at (point))) + (found nil)) + (while (and (not found) (overlayp (car overlays))) + (setq found (overlay-get (car overlays) 'fold) + overlays (cdr overlays))) + found) + (save-excursion + (goto-char pos) + (beginning-of-line) + (skip-chars-forward "^\r" pos) + (not (eq pos (point)))))) + +;;}}} + +;;}}} +;;{{{ code: Additional functions + +(defvar folding-comment-folding-table + '((c-mode + folding-comment-c-mode + folding-uncomment-c-mode)) + "Table of functions to comment and uncomment folds. +Function is called with two arguments: + + number start of fold mark + marker end of fold mark + +Function must return: + + (beg . end) start of fold, end of fold + +Table Format: + '((MAJOR-MODE COMMENT-FUNCTION UNCOMMENT-FUNCTION) ..)") + +(defun folding-insert-advertise-folding-mode () + "Insert Small text describing where to the get the folding at point. +This may be useful 'banner' to inform other people why your code +is formatted like it is and how to view it correctly." + (interactive) + (let* ((prefix "") + (re (or comment-start-skip + (and comment-start + (concat "^[ \t]*" comment-start "+[ \t]*"))))) + + (when re + (save-excursion + (beginning-of-line) + (when (or (re-search-forward re nil t) + (progn + (goto-char (point-min)) + (re-search-forward re nil t))) + (setq prefix (match-string 0))))) + + (beginning-of-line) + (dolist (line + (list + "File layout controlled by Emacs folding.el available at: " + folding-package-url-location)) + (insert "\n" prefix line)))) + +(defun folding-uncomment-mode-generic (beg end tag) + "In region (BEG . END) remove two TAG lines." + (re-search-forward tag (marker-position end)) + (beginning-of-line) + (kill-line 1) + (re-search-forward tag (marker-position end)) + (beginning-of-line) + (kill-line 1) + (cons beg end)) + +(defun folding-comment-mode-generic (beg end tag1 &optional tag2) + "Return (BEG . END) and Add two TAG1 and TAG2 lines." + (insert tag1) + (goto-char (marker-position end)) + (insert (or tag2 tag1)) + (cons beg end)) + +(defun folding-uncomment-c-mode (beg end) + "Uncomment region BEG END." + (folding-uncomment-mode-generic + beg end (regexp-quote " comment /* FOLDING -COM- */"))) + +(defun folding-comment-c-mode (beg end) + "Comment region BEG END." + (let* ((tag " /* FOLDING -COM- */")) + (folding-comment-mode-generic + beg end + (concat "#if comment" tag "\n") + (concat "#endif comment" tag "\n")))) + +(defun folding-comment-fold (&optional uncomment) + "Comment or UNCOMMENT all text inside single fold. +If there are subfolds this function won't work as expected. +User must know that there are no subfolds. + +The heading has -COM- at the end when the fold is commented. +Point must be over fold heading {{{ when function is called. + +Note: + + You can use this function only in modes that do _not_ have + `comment-end'. Ie. don't use this function in modes like C (/* */), because + nested comments are not allowed. See this: + + /* {{{ fold */ + code /* comment of the code */ + /* }}} */ + + Fold can't know how to comment the `code' inside fold, because comments + do not nest. + +Implementation detail: + + {{{ FoldHeader-COM- + + If the fold header has -COM- at the end, then the fold is supposed to + be commented. And if there is no -COM- then fold will be considered + as normal fold. Do not loose or add the -COM- yourself or it will + confuse the state of the fold. + +References: + + `folding-comment-folding-table'" + (interactive "P") + (let* ((state (folding-mark-look-at 'move)) + (closed (eq 0 state)) + (id "-COM-") + (opoint (point)) + (mode-elt (assq major-mode folding-comment-folding-table)) + comment + ret + beg + end) + (unless mode-elt + (if (stringp (nth 2 (folding-get-mode-marks major-mode))) + (error "\ +Folding: function usage error, mode with `comment-end' is not supported."))) + (when (or (null comment-start) + (not (string-match "[^ \t\n]" comment-start))) + (error "Empty comment-start.")) + (unless (memq state '( 0 1 11)) + (error "Incorrect fold state. Point must be over {{{.")) + ;; There is nothing to do if this fold heading does not have + ;; the ID when uncommenting the fold. + (setq state (looking-at (concat ".*" id))) + (when (or (and uncomment state) + (and (null uncomment) (null state))) + (when closed (save-excursion (folding-show-current-entry))) + (folding-pick-move) ;Go to end + (beginning-of-line) + (setq end (point-marker)) + (goto-char opoint) ;And off the fold heading + (forward-line 1) + (setq beg (point)) + (setq comment (concat comment-start id)) + (cond + (mode-elt + (setq ret + (if uncomment + (funcall (nth 2 mode-elt) (point) end) + (funcall (nth 1 mode-elt) (point) end))) + (goto-char (cdr ret))) + (uncomment + (while (< (point) (marker-position end)) + (if (looking-at comment) + (delete-region (point) (match-end 0))) + (forward-line 1))) + (t + (while (< (point) (marker-position end)) + (if (not (looking-at comment)) + (insert comment)) + (forward-line 1)))) + (setq end nil) ;kill marker + ;; Remove the possible tag from the fold name line + (goto-char opoint) + (setq id (concat (or comment-start "") id (or comment-end ""))) + (if (re-search-forward (regexp-quote id) beg t) + (delete-region (match-beginning 0) (match-end 0))) + (when (null uncomment) + (end-of-line) + (insert id)) + (if closed + (folding-hide-current-entry)) + (goto-char opoint)))) + +(defun folding-convert-to-major-folds () + "Convert fold mark items according to `major-mode'. +This function replaces all fold markings }}} and {{{ +with major mode's fold marks. + +As a side effect also corrects all foldings to standard notation. +Eg. following, where correct folding-beg should be \"#{{{ \" +Note that /// marks foldings. + + /// ;wrong fold + # /// ;too many spaces, fold format error + # ///title ;ok, but title too close + + produces + + #/// + #/// + #/// title + +You must 'unfold' whole buffer before using this function." + (interactive) + (let (case-fold-search + (bm "{{{") ; begin match mark + (em "}}}") ; + el ; element + b ; begin + e ; end + e2 ; end2 + pp) + (catch 'out ; is folding active/loaded ?? + (unless (setq el (folding-get-mode-marks major-mode)) + (throw 'out t)) ; ** no mode found + ;; ok , we're in business. Search whole buffer and replace. + (setq b (elt el 0) + e (elt el 1) + e2 (or (elt el 2) "")) + (save-excursion + (goto-char (point-min)) ; start from the beginning of buffer + (while (re-search-forward (regexp-quote bm) nil t) + ;; set the end position for fold marker + (setq pp (point)) + (beginning-of-line) + (if (looking-at (regexp-quote b)) ; should be mode-marked; ok, ignore + (goto-char pp) ; note that beg-of-l cmd, move rexp + (delete-region (point) pp) + (insert b) + (when (not (string= "" e2)) + (unless (looking-at (concat ".*" (regexp-quote e2))) + ;; replace with right fold mark + (end-of-line) + (insert e2))))) + ;; handle end marks , identical func compared to prev. + (goto-char (point-min)) + (while (re-search-forward (regexp-quote em)nil t) + (setq pp (point)) + (beginning-of-line) + (if (looking-at (regexp-quote e)) + (goto-char pp) + (delete-region (point) (progn (end-of-line) (point))) + (insert e))))))) + +(defun folding-all-comment-blocks-in-region (beg end) + "Put all comments in folds inside BEG END. +Notice: Make sure there is no interfering folds inside the area, +because the results may and up corrupted. + +This only works for modes that DO NOT have `comment-end'. +The `comment-start' must be left flushed in order to counted in. + +After this + + ;; comment + ;; comment + + code + + ;; comment + ;; comment + + code + +The result will be: + + ;; {{{ 1 + + ;; comment + ;; comment + + ;; }}} + + code + + ;; {{{ 2 + + ;; comment + ;; comment + + ;; }}} + + code" + (interactive "*r") + + (unless comment-start + (error "Folding: Mode does not define `comment-start'")) + + (when (and (stringp comment-end) + (string-match "[^ \t]" comment-end)) + (error "Folding: Mode defines non-empty `comment-end'.")) + (let* ((count 0) + (comment-regexp (concat "^" comment-start)) + (marker (point-marker)) + done) + (destructuring-bind (left right ignore) + (folding-get-mode-marks) + ;; Bytecomp silencer: variable ignore bound but not referenced + (if ignore (setq ignore ignore)) + ;; %%%{{{ --> "%%%" + (string-match (concat (regexp-quote comment-start) "+") left) + (save-excursion + (goto-char beg) + (beginning-of-line) + (while (re-search-forward comment-regexp nil t) + (move-marker marker (point)) + (setq done nil) + (beginning-of-line) + (forward-line -1) + ;; 2 previous lines Must not contain FOLD beginning already + (unless (looking-at (regexp-quote left)) + (forward-line -1) + (unless (looking-at (regexp-quote left)) + (goto-char (marker-position marker)) + (beginning-of-line) + (insert left " " (int-to-string count) "\n\n") + (incf count) + (setq done t))) + (goto-char (marker-position marker)) + (when done + ;; Try finding pat of the comment block + (if (not (re-search-forward "^[ \t]*$" nil t)) + (goto-char end)) + (open-line 1) + (forward-line 1) + (insert right "\n"))))))) + +;;}}} +;;{{{ code: Overlay support + +(defun folding-use-overlays-p () + "Should folding use overlays?." + (if folding-allow-overlays + (if folding-xemacs-p + ;; See if we can load overlay.el library that comes in 19.15 + ;; This call returns t or nil if load was successful + ;; Note: is there provide statement? Load is so radical + ;; + (load "overlay" 'noerr) + t))) + +(defun folding-flag-region (from to flag) + "Hide or show lines from FROM to TO, according to FLAG. +If FLAG is nil then text is shown, while if FLAG is t the text is hidden." + (let ((inhibit-read-only t) + overlay) + (save-excursion + (goto-char from) + (end-of-line) + (cond + (flag + (setq overlay (make-overlay (point) to)) + (folding-make-overlay-hidden overlay)) + (t + (if (fboundp 'hs-discard-overlays) + (funcall (symbol-function 'hs-discard-overlays) + (point) to 'invisible t))))))) + +(defun folding-make-overlay-hidden (overlay) + "Make OVERLAY hidden." + (overlay-put overlay 'fold t) + ;; (overlay-put overlay 'intangible t) + (overlay-put overlay 'invisible t) + (overlay-put overlay 'owner 'folding)) + +(defun folding-narrow-aux (start end arg) + "Narrow. Make overlay from `point-min' to START. +And from END t `point-min'. If ARG is nil, delete overlays." + (if (null arg) + (cond + (folding-narrow-overlays + (delete-overlay (car folding-narrow-overlays)) + (delete-overlay (cdr folding-narrow-overlays)) + (setq folding-narrow-overlays nil))) + (let ((overlay-beg (make-overlay (point-min) start)) + (overlay-end (make-overlay end (point-max)))) + (overlay-put overlay-beg 'folding-narrow t) + (overlay-put overlay-beg 'invisible t) + (overlay-put overlay-beg 'owner 'folding) + (overlay-put overlay-end 'folding-narrow t) + (overlay-put overlay-end 'invisible t) + (overlay-put overlay-end 'owner 'folding) + (setq folding-narrow-overlays (cons overlay-beg overlay-end))))) + +;;}}} +;;{{{ code: end of file tag, provide + +(folding-install) + +(provide 'folding) +(provide 'folding-isearch) ;; This used to be a separate package. + +(run-hooks 'folding-load-hook) + +;;}}} + +;;; folding.el ends here diff --git a/elisp/emacs-goodies-el/framepop.el b/elisp/emacs-goodies-el/framepop.el new file mode 100755 index 0000000..0a8c73d --- /dev/null +++ b/elisp/emacs-goodies-el/framepop.el @@ -0,0 +1,939 @@ +;;; framepop.el --- display temporary buffers in a dedicated frame + +;; Copyright (C) 1993, 1995 Free Software Foundation, Inc. +;; Copyright (C) 2003 Peter S Galbraith + +;; Author: David Smith +;; Maintainer: Peter S Galbraith +;; (I'll assign copyright to the FSF if requested. Send patches only if +;; you are willing to do the same. Contact me if you want to *actively* +;; maintain this file.) +;; Created: 8 Oct 1993 by David Smith +;; Modified: $Date: 2003-10-15 14:16:54 $ +;; Version: $Revision: 1.11 $ +;; RCS-Id: $Id: framepop.el,v 1.11 2003-10-15 14:16:54 psg Exp $ + +;; 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, 675 Mass Ave, Cambridge, MA 02139, USA. + +;;; Commentary: + +;; 1. PURPOSE + +;; Defines temp-buffer-show-function to display buffers in a dedicated +;; temporary frame (and so requires a display which can accomodate +;; separate frames). The frame is automatically shrink-wrapped to just +;; contain the buffer (restricted to a maximum and minimum +;; size). Buffers thus affected include *Help*, completion buffers and +;; buffer listings. +;; +;; Commands are provided for manipulating the FramePop frame: +;; scrolling, resizing, window manager functions, and also a facility +;; for copying the displayed buffer. You need never lose that handy +;; *Help* buffer again! +;; +;; Framepop is orthogonal to the Emacs' special-display-buffers feature; +;; you can use both at the same time if you so desire. You can make +;; special-display buffers appear in the FramePop frame as well, if you +;; wish; see below. + +;; 2. INSTALLATION + +;; To make use of this package, place this file in your load-path, +;; byte-compile it *before* loading it (or do M-x ad-deactivate-all +;; first), and add the following line to your .emacs: +;; +;; (when window-system +;; (require 'framepop) +;; (framepop-enable)) +;; +;; or, alternatively, load the file once, customize the variable +;; `framepop-enable' and save the setting. The file will then be loaded +;; automatically and enabled on startup. + +;; Several user functions are defined and stored in framepop-map. You +;; will probably want to bind these to keys. See `M-x customize-variable RET +;; framepop-enable-keybinding RET' +;; +;; Type M-x framepop-display-help (bound to `?' in framepop-map) for +;; more information. + +;; 3. CUSTOMIZATION + +;; See `M-x customize-group RET framepop'. + +;; The maximum and minimum height of the framepop buffer are +;; determined by the user options `framepop-max-frame-size' and +;; `framepop-min-frame-size'. + +;; The variable `framepop-frame-parameters' holds the FramePop frame +;; parameters. You can define colours, fonts and positions for the +;; FramePop frame here. For example: +;; +;; (setq framepop-frame-parameters +;; '((name . nil) ; use buffer name +;; (unsplittable . t) ; always include this +;; (menu-bar-lines . 0) ; no menu bar +;; (minibuffer . nil) ; or minubuffer +;; (left . -1) ; top left corner of screen, +;; (top . 30) ; away from my main frame +;; (width . 71) ; narrower, so it fits nicely +;; (background-color . "orchid4") ; I like purple. So sue me. +;; (foreground-color . "cornsilk") +;; (font . "-*-courier-bold-o-*-*-12-*-*-*-m-*-*-*"))) +;; +;; But you may use the customize interface to edit `framepop-frame-parameters'. + +;; By default, only temporary buffers (which call +;; `temp-buffer-show-function') are displayed in the FramePop frame. To +;; make other buffers also appear in the selected frame, the easiest thing +;; to do is make buffers listed in special-display-buffer-names or +;; special-display-regexps appear in the framepop frame by adding the +;; following to your .emacs file: +;; +;; (setq special-display-function 'framepop-special-display) +;; +;; Here's a suggestion for some buffers to use this feature on: +;; +;; (setq special-display-buffer-names '("*Shell Command Output*" +;; "*grep*" "*compilation*")) + +;; Alternatively (if you want to keep the special-display feature +;; separate from framepop) you can use the function `framepop-wrap'. + +;; There are lots of nifty things that can be done with the advice +;; package to make FramePop work that much better. Many such things +;; will be done for you automatically if you +;; +;; (require 'advice) +;; +;; before loading the framepop package (or customize the variable +;; `framepop-use-advice'. See the end of this file ("Customizations using +;; advice") for more details. + +;; Buffer names listed in the variable framepop-do-not-display-list +;; will not be displayed in the framepop-frame by default. +;; +;; You may set the variable `framepop-auto-resize' to t to have the +;; FramePop frame automatically resize to accomodate buffers which +;; change size. If you do not, initially empty buffers (which are +;; likely to grow) get a FramePop frame of full size. + +;; For elisp hackers: +;; +;; Alternatively, for greater control over the behaviour of the +;; framepop frame, you can redefine the variable `framepop-lines' to a +;; lambda expression which will return the desired height of a buffer +;; to be displayed in the framepop frame. It may also return nil, +;; meaning that the buffer should not be displayed in the FramePop +;; frame, but in an ordinary window instead. The default value of this +;; lambda expression is the number of lines in the buffer, except that +;; empty buffers and compilation buffers (both of which are likely to +;; grow) get full size. You may wish to disable this feature, or +;; perhaps make other constraints based on buffer mode, etc. For +;; example, placing the following in your .emacs will force the +;; framepop frame to have as many lines as the buffer being displayed +;; provided it is not the *Completions* buffer (which will not be +;; displayed in the FramePop frame at all): +;; +;; (setq framepop-lines +;; '(lambda (buf) +;; (if (string= (buffer-name buf) "*Completions*") nil +;; (save-excursion +;; (set-buffer buf) +;; (+ (count-lines (point-min) (point-max)) 1))))) +;; +;; This will cause empty buffers to have the minimum height, because +;; the maximum and minimum frame sizes (as specified in +;; `framepop-max-frame-size' and `framepop-min-frame-size') are enforced +;; independently of `framepop-lines'. To get around this, define advice +;; around the function `framepop-frame-height'. +;; +;; The default value of `framepop-lines' is framepop-default-lines. + +;; BUGS: +;; +;; 1. Completion in comint buffers doesn't work very well unless +;; comint-dynamic-show-completions is given a lobotomy. NB: this +;; happens by default if advice is loaded. +;; 2. I'd like to redefine framepop-wrap so that it saves the window +;; configuration, displays the requested buffer in the +;; framepop-frame, and then restores the window configuration. But +;; the job of framepop-wrap is better done by +;; special-display-buffer-names, so I shan't bother. + +;;; History: +;; +;; October 2003 - Peter S Galbraith +;; Since David Smith no longer uses Emacs, I have decided to do a bit of +;; work to update the file before packaging it for Debian. This involved +;; mostly switching to the customize interface. It's still very much +;; David's work. + +;;; Code: + +(defconst framepop-version (substring "$Revision: 1.11 $" 11 -2) + "The revision number of the framepop package. + +The complete RCS ID is: +$Id: framepop.el,v 1.11 2003-10-15 14:16:54 psg Exp $") + +;;; Customizable variables at end + +(defgroup framepop nil + "Display temporary buffers in a dedicated frame." + :group 'frames) + +;;;###autoload +(defun framepop-disable nil + "Disable automatic pop-up temporary windows." + (interactive) + (setq temp-buffer-show-function nil)) + +;;;###autoload +(defun framepop-enable nil + "Enable automatic pop-up temporary windows." + (interactive) + (if (and temp-buffer-show-function + (not (eq temp-buffer-show-function 'framepop-display-buffer))) + (message "Warning: framepop.el has redefined temp-buffer-show-function")) + (setq temp-buffer-show-function 'framepop-display-buffer)) + +(defcustom framepop-enable nil + "Whether to enable and use FramePop for temporary buffers." + :group 'framepop + :type 'boolean + :require 'framepop + :set (lambda (symbol value) + (set-default symbol value) + (if (and value window-system) + (framepop-enable) + (framepop-disable)))) + +(defvar framepop-map nil) +(if framepop-map nil + (setq framepop-map (make-sparse-keymap)) + (define-key framepop-map "?" 'framepop-display-help) + (define-key framepop-map "s" 'framepop-show-frame) + (define-key framepop-map "k" 'framepop-kill-buffer) + (define-key framepop-map "d" 'framepop-delete-frame) + (define-key framepop-map "i" 'framepop-make-invisible-frame) + (define-key framepop-map "w" 'framepop-resize-frame) + (define-key framepop-map "g" 'framepop-grow) + (define-key framepop-map "c" 'framepop-copy-frame) + (define-key framepop-map "/" 'framepop-pull-down) + (define-key framepop-map ">" 'framepop-eob) + (define-key framepop-map "<" 'framepop-bob) + (define-key framepop-map "v" 'framepop-scroll-frame) + (define-key framepop-map "l" 'framepop-lower-frame) + (define-key framepop-map "r" 'framepop-raise-frame) + (define-key framepop-map [f2] 'framepop-iconify-frame) + (define-key framepop-map "x" 'framepop-iconify-frame) + (define-key framepop-map "z" 'framepop-toggle-frame) + (define-key framepop-map "b" 'framepop-display-buffer)) +(defcustom framepop-enable-keybinding nil + "Global key binding for FramePop keymap. +The key F2 is suggested." + :group 'framepop + :type '(choice (const :tag "Not enabled" nil) + (const "") + (string :tag "key sequence (string)")) + :set (lambda (symbol value) + (set-default symbol value) + (if value + (define-key global-map (read-kbd-macro value) framepop-map)))) + +(defcustom framepop-use-advice 'automatic + "Whether to use `advice' to extend Framepop functionality" + :group 'framepop + :type '(radio (const :tag "Yes" t) + (const :tag "No" nil) + (const :tag "Automatically if `advice' is already loaded" + :value automatic))) + +(defcustom framepop-max-frame-size 35 + "*Maximum height of the FramePop frame." + :group 'framepop + :type 'integer) + +(defcustom framepop-min-frame-size 5 + "*Minimum height of the FramePop frame." + :group 'framepop + :type 'integer) + +(defcustom framepop-auto-resize nil + "Whether to dynamically resize for changing buffers." + :group 'framepop + :type 'boolean) + +(defcustom framepop-resize-increment 4 + "*When auto-resizing, frame height is forced to a multiple of this value. +This prevents excessive frame recreations on slow displays." + :group 'framepop + :type 'integer) + +;; FIXME: Make this a list or regexp to build a single \\| expression from? +(defcustom framepop-buffer-names-that-grow + "^\\\\*grep\\\\*$\\|\\\\*[Cc]ompilation\\\\*$" + "Regexp matching buffer names that are likely to grow from empty. +When `framepop-auto-resize' is nil, buffers with names matching this regexp +are given a framepop frame of maximal size, to accomodate the data which +is soon to appear." + :group 'framepop + :type 'regexp) + +;; If you want the title of the FramePop frame to be *Help* or +;; *Completions* or whatever, remove the (name . "FRAMEPOP") parameter +;; in framepop-frame-parameters below. +;; +;; If you want the FramePop frame to autoraise when selected, +;; uncomment the approprate line below +;; +;; Colours and positions are also good things to set here. There +;; should be no "height" parameter. + +(defcustom framepop-frame-parameters + '((name . "FRAMEPOP") + (unsplittable . t) ; always include this + (width . 80) ; this parameter is needed + (menu-bar-lines . 0) + (tool-bar-lines . 0) + (minibuffer . nil)) + "Default parameters used in with the FramePop frame." + :type '(set (cons :tag "Constant frame name (optional)" + (const name) string) + (cons :tag "Cannot be split" + (const unsplittable) + (boolean :tag "Boolean (Should be on)" )) + (cons :tag "Width of the Frame" + (const width :tag "width (required parameter)") integer) + (cons :tag "Auto-raise" + (const auto-raise) boolean) + (cons :tag "Frame Position" + (const left) number) + (cons :tag "Frame Position" + (const top) number) + (cons :tag "Frame Position" + (const user-position) boolean) + (cons :tag "Background Color" + (const background-color) color) + (cons :tag "Foreground Color" + (const foreground-color) color) + (cons :tag "Disable menubar" + (const menu-bar-lines) + (integer :tag "Integer (Should be 0)")) + (cons :tag "Disable Tool-bar" + (const tool-bar-lines) + (integer :tag "Integer (Should be 0)")) + (cons :tag "Disable Minibuffer" + (const minibuffer) + (boolean :tag "Boolean (Should be off)"))) + :tag "FramePop Frame Parameters" + :group 'framepop) + +(defcustom framepop-do-not-display-list '("*Buffer List*") + "List of buffer names which will not appear in the FramePop frame. +This behaviour is implemented by the function `framepop-lines-default +'" + :group 'framepop + :type '(repeat (string :tag "Buffer name"))) + +;;; Variables controlling gross hacks + +(defcustom framepop-hack-help-buffer-title t + "Try and produce sensible names for copied help buffers." + :group 'framepop + :type 'boolean) + +;;; System variables + +(defvar framepop-lines + 'framepop-lines-default + "Lambda expression of one argument BUF. +It returns the number of lines the framepop frame should have to display +BUF. If nil is returned, BUF is not displayed in the framepop frame.") + +(defvar framepop-in-wrap nil + "Flag set to t during the execution of commands wrapped with `framepop-wrap'.") + +(defvar framepop-last-displayed-buffer "" + "Name of last buffer displayed in temp frame.") + +(defvar framepop-frame nil) + +;; Is it XEmacs? +(defconst framepop-xemacs-p + (string-match "\\(Lucid\\|XEmacs\\)" emacs-version)) + +;;; Shut up the byte compiler + +(eval-when-compile + (require 'compile) + (require 'advice) + (require 'reporter)) + +;;; System functions + +(defun framepop-frame-height (buf) + "Return the desired height of a FramePop frame showing buffer BUF. +Enforces the limits set by `framepop-max-frame-size' and +`framepop-min-frame-size'" + (let ((lines (funcall framepop-lines buf))) + (if lines + (max (min framepop-max-frame-size + (funcall framepop-lines buf)) + framepop-min-frame-size)))) + +(defun framepop-buffer nil + "Return the buffer the framepop window is showing, or nil." + (if (frame-live-p framepop-frame) + (window-buffer (frame-root-window framepop-frame)))) + +(defun framepop-last-non-newline-char () + "Return the position of the last non-newline character in the current buffer." + (save-excursion + (goto-char (point-max)) + (save-match-data + (re-search-backward "[^\n]" nil t)) + (point))) + +(defun framepop-count-visual-lines (buf &optional max frame) + "Return the number of visual lines in BUF as opposed to the actual lines. +If MAX is supplied, counting stops after MAX lines. MAX defaults to +`framepop-max-frame-size'. The maximum size of a visual line is determined +by the width of frame FRAME \(defaults to `framepop-frame')." + (if framepop-xemacs-p + ;; This is inaccurate by one line, if a line that has 79 characters + ;; generates 2 visual lines. + (let* ((count 0) + (max (or max framepop-max-frame-size)) + (frame (or frame framepop-frame)) + (width (- (or (frame-width frame) + (cdr (assq 'width framepop-frame-parameters)) + (frame-width (selected-frame))) 1)) + col) + (save-excursion + (set-buffer buf) + (if truncate-lines + (min max (count-lines (point-min) (point-max))) + (save-excursion + (goto-char (point-min)) + (while (and (not (eobp)) (< count max)) + ;; Add one for this logical line + (setq count (1+ count)) + (while (not (eolp)) + ;; Add on the extra screen lines it generates + (setq col (+ (current-column) width)) + (move-to-column col) + (if (and (eq (current-column) col) (not (eolp))) + (setq count (1+ count)))) + ;; move to the next line, if possible + (if (not (eobp)) (forward-char 1))) + ;; Add one for a terminating newline + (if (and (eobp) (eq (preceding-char) ?\n)) + (setq count (1+ count))) + count)))) + ;; FSF GNU Emacs has a nice function for doing this :) + (save-excursion + (set-buffer buf) + (1+ (nth 2 + (compute-motion + 1 ; FROM + '(0 . 0) ; FROMPOS + (framepop-last-non-newline-char) ; TO + (cons 0 ; TOPOS horizontal + (1- (or max framepop-max-frame-size))) ; TOPOS vertical + (1- (cdr (assq 'width framepop-frame-parameters))) ; WIDTH + nil ; OFFSET + (if (frame-live-p framepop-frame) ; WINDOW + (frame-root-window framepop-frame) + (selected-window)))))) + )) + +(defun framepop-lines-default (buf) + "The default value for `framepop-lines'. +Ensures that the FramePop frame will be big enough to display all of BUF. +However, returns nil for buffers in `framepop-do-not-display-list'." + (save-excursion + (set-buffer buf) + (if (member (buffer-name) framepop-do-not-display-list) nil + (+ + (if (and (not framepop-auto-resize) + (or + ;; likely to grow + (eq (buffer-size) 0) + (string-match framepop-buffer-names-that-grow (buffer-name)))) + framepop-max-frame-size + (framepop-count-visual-lines buf)) + (if (cdr (assq 'minibuffer (frame-parameters framepop-frame))) + 1 0) + 1 ;; for the mode line + )))) + +;;; User commands + +(defun framepop-resize-frame (&optional buf height) + "Resize the framepop frame to accomodate buffer BUF. +BUF defaults to the buffer displayed in the framepop frame +If HEIGHT is non-nil, BUF is ignored and the frame is given height." + (interactive) + (let* ((win (frame-root-window framepop-frame)) + (buf (or buf (window-buffer win)))) + (modify-frame-parameters framepop-frame + (list (cons 'height + (or height (framepop-frame-height buf))))))) + +(defun framepop-pull-down nil + "If last line of framepop buffer is visible, place it on last window line." + (interactive) + (let* ((win (frame-root-window framepop-frame)) + (buf (window-buffer win)) + (pmax (save-excursion + (set-buffer buf) + (point-max)))) + (if (= (window-end win) pmax) + (let ((oldwin (selected-window))) + (select-window win) + (save-excursion + (goto-char pmax) + (recenter -1)) + (select-window oldwin))))) + +(defun framepop-grow (lines) + "Increase the height of the framepop frame by LINES lines. +When called interactively, LINES is the numeric prefix argument" + (interactive "p") + (modify-frame-parameters + framepop-frame + (list (cons 'height + (max 2 (+ lines + (cdr (assoc 'height + (frame-parameters framepop-frame))))))))) +(defun framepop-display-help nil + "Display help for the framepop commands." + (interactive) + (describe-function 'framepop-display-buffer) + (save-excursion + (set-buffer (framepop-buffer)) ; *Help* + (save-excursion + (goto-char (point-min)) + (let ((framepop-resize-increment 1)) + (delete-region (point) + (progn + ;; Delete the framepop-display-buffer-specific stuff + (forward-line 7) + (point))) + (insert "Framepop help:\n\n")))) + (if framepop-auto-resize nil + (framepop-resize-frame))) + +;;;###autoload +(defun framepop-display-buffer (buf) + ;; Note: the fifth line of this docstring should begin general help: + ;; see framepop-display-help + "Display-buffer for FramePop. +Displays BUF in a separate frame -- the FramePop frame. +BUF bay be a buffer or a buffer name. + +You can display a buffer in the FramePop frame with \\[framepop-display-buffer]. + +Several commands are available for manipulating the FramePop frame after +typing the keymap prefix (default F2). + +\\{framepop-map} +" + (interactive "bDisplay buffer: ") + (and (stringp buf) (setq buf (get-buffer buf))) + (let ((oframe (selected-frame)) + ;;(omouse (mouse-position)) + (lines (framepop-frame-height buf))) + (if (not lines) + ;; framepop-lines should return nil for buffers which + ;; shouldn't be displayed in the framepop frame + (display-buffer buf) + (if (frame-live-p framepop-frame) nil + ;; No existing framepop frame + (setq framepop-frame + (make-frame (cons (cons 'height lines) + framepop-frame-parameters)))) + ;; For XEmacs, kill toolbars + ;; Can't kill frame menubar in XEmacs til 19.13 comes out + (if framepop-xemacs-p + (progn + (set-specifier top-toolbar-height (list framepop-frame 0)) + (set-specifier bottom-toolbar-height (list framepop-frame 0)) + (set-specifier left-toolbar-width (list framepop-frame 0)) + (set-specifier right-toolbar-width (list framepop-frame 0)))) + (delete-other-windows (frame-selected-window framepop-frame)) + (set-window-dedicated-p (frame-selected-window framepop-frame) nil) + (set-window-buffer (frame-selected-window framepop-frame) buf) + (set-window-dedicated-p (frame-selected-window framepop-frame) t) + (framepop-resize-frame) + ;; (framepop-bob) + (setq framepop-last-displayed-buffer (buffer-name buf)) + (if framepop-auto-resize + (save-excursion + (set-buffer buf) + (make-local-variable 'after-change-functions) + ;; Some functions (e.g. grep) display the temporary buffer + ;; before setting its mode (which wipes buffer-local + ;; variables). Prevent that happening. + (put 'after-change-functions 'permanent-local t) + (add-hook 'after-change-functions 'framepop-resizer t))) + (raise-frame framepop-frame) + (if (minibuffer-window-active-p (minibuffer-window)) nil + ;; Replace the default message with something more suitable + (let ((message-log-max nil)) ; don't log this message + (message (substitute-command-keys + "Type \\[framepop-scroll-frame] to scroll, \\[framepop-iconify-frame] to iconify")))) + + ;; PSG - Let minibuffer [TAB] scroll *completions* buffer + ;; There is probably a better (less-generic) way of setting this up. + (setq minibuffer-scroll-window (frame-root-window framepop-frame)) + + ;; Set focus on the original frame + (if framepop-xemacs-p + (let ((wind (frame-lowest-window oframe))) + ;; XEmacs doesn't have a function that redirects focus + (select-frame oframe) + (set-mouse-position + wind (1- (window-width wind)) (1- (window-height wind)))) + (redirect-frame-focus framepop-frame oframe))))) + +(defun framepop-resizer (beg end pre-change-length) + "Bound to after-change-function to automatically resize the framepop frame." + ;; If a after-change-buffer has somehow escaped being reset, do it now + (if (and framepop-auto-resize (eq (framepop-buffer) (current-buffer))) + (let ((bufheight (framepop-frame-height (current-buffer)))) + (framepop-resize-frame nil + ;; round up to framepop-resize-increment + (if (zerop (mod bufheight framepop-resize-increment)) bufheight + (* (1+ (/ bufheight framepop-resize-increment)) + framepop-resize-increment)))) + ;; otherwise... + (remove-hook 'after-change-functions 'framepop-resizer))) + +(defun framepop-iconify-frame nil + "Iconify the FramePop frame." + (interactive) + (if (frame-live-p framepop-frame) + (iconify-frame framepop-frame) + (message "FramePop frame deleted"))) + +(defun framepop-make-invisible-frame nil + "Make the FramePop frame invisible." + (interactive) + (if (frame-live-p framepop-frame) + (make-frame-invisible framepop-frame) + (message "FramePop frame deleted"))) + +(defun framepop-show-frame nil + "Force the FramePop frame to be visible." + (interactive) + (if (frame-live-p framepop-frame) + (raise-frame framepop-frame) + (let ((buf (or + (get-buffer framepop-last-displayed-buffer) + (get-buffer "*Help*")))) + (if buf + (framepop-display-buffer buf) + (message "Last displayed temporary buffer has been killed."))))) + +(defun framepop-delete-frame nil + "Delete (destroy) the FramePop frame." + (interactive) + (delete-frame framepop-frame)) + +(defun framepop-kill-buffer nil + "Delete (destroy) the FramePop frame and its kill the buffer it was showing." + (interactive) + (kill-buffer (framepop-buffer)) + (delete-frame framepop-frame)) + +(defun framepop-toggle-frame nil + "Iconify or deiconify the FramePop frame." + (interactive) + (if (frame-live-p framepop-frame) + (let ((oframe (selected-frame))) + (if framepop-xemacs-p + (progn + (select-frame framepop-frame) ; XEmacs takes only one arg + (if (frame-iconified-p framepop-frame) + (deiconify-frame framepop-frame) + (iconify-frame framepop-frame))) + (select-frame framepop-frame t) + (iconify-or-deiconify-frame)) + ;; (bury-buffer (framepop-buffer)) + (select-frame oframe)) + (message "No active FramePop frame"))) + +(defun framepop-scroll-frame (n) + "Like `scroll-other-window', but scrolls the window in the FramePop frame. +Scroll-up N lines." + (interactive "P") + (framepop-show-frame) + (save-window-excursion + (select-window (frame-root-window framepop-frame)) + (scroll-up n))) + +(defun framepop-bob nil + "Go to the beginning of the framepop buffer." + (interactive) + (framepop-show-frame) + (let* ((win (frame-root-window framepop-frame)) + (buf (window-buffer win)) + (min (save-excursion + (set-buffer buf) + (point-min)))) + (set-window-point win min))) + +(defun framepop-eob nil + "Go to the end of the framepop buffer, and resize the framepoop frame. +Useful for buffers (e.g. compilations) which grow" + (interactive) + (framepop-show-frame) + (sit-for 0) + (let* ((win (frame-root-window framepop-frame)) + (buf (window-buffer win))) + (set-window-point win (save-excursion + (set-buffer buf) + (point-max)))) + (sit-for 0) ; redisplay + (framepop-pull-down)) + +(defun framepop-lower-frame nil + "Lower the FramePop frame." + (interactive) + (if (frame-live-p framepop-frame) + (lower-frame framepop-frame) + (message "No active FramePop frame"))) + +(defun framepop-raise-frame nil + "Raise the FramePop frame." + (interactive) + (if (frame-live-p framepop-frame) + (raise-frame framepop-frame) + (message "No active FramePop frame"))) + +(defun framepop-copy-frame (copy-buffer) + "Duplicate the FramePop frame, and maybe the displayed buffer as well. +With a prefix arg (COPY-BUFFER), the buffer is also copied and given a +unique name. This is useful for *Help*, *Completions* etc." + (interactive "P") + (let ((oframe (selected-frame)) + new-frame + buf + contents + pos) + (select-frame framepop-frame) + (setq pos (point)) + (setq new-frame (make-frame (frame-parameters framepop-frame))) + (modify-frame-parameters new-frame '((name . nil))) + (if copy-buffer + (progn + (let ((helpobj)) + (setq buf (if (and framepop-hack-help-buffer-title + (string= (buffer-name) "*Help*") + (progn + (condition-case () + (save-excursion + (goto-char (point-min)) + (search-forward ":" (min + (save-excursion + (end-of-line) + (point)) + (+ (point-min) 50))) + (setq helpobj (buffer-substring + (point-min) + (match-beginning 0)))) + (error nil)) + ;; (intern-soft helpobj) + )) + (generate-new-buffer (format "*Help* on %s" helpobj)) + (generate-new-buffer (buffer-name))))) + (select-frame new-frame) + (setq contents (buffer-string)) + (save-excursion + (set-buffer buf) + (insert contents) + (goto-char pos) + (switch-to-buffer buf)))) + (select-frame oframe))) + +(defun framepop-wrap (function buffer) + "Define a wrapper on FUNCTION so that BUFFER will appear in a FramePop frame. +BUFFER may be a buffer, a buffer name, or a sexp evaluating to a buffer or +buffer name. The function is advised with around advice named +framepop-display-buffer-in-framepop-frame. + +WARNING: this will not work on autoloaded functions unless forward +advice has been enabled. You must use `ad-activate' to activate the advice +after the package has been loaded. See advice.el for details." + (require 'advice) + (require 'backquote) + (ad-add-advice + function + (ad-make-advice + 'framepop-display-buffer-in-framepop-frame + t + t + (` (advice lambda nil + ;; docstring: + (, (format "Displays %s buffer in a FramePop frame" + (if (stringp buffer) buffer "output"))) + ;; body + (let ((framepop-in-wrap t)) + ad-do-it + (let* ((arg (, buffer)) + (buf (if (stringp arg) (get-buffer arg) arg))) + (cond ((bufferp buf) + (delete-windows-on buf) + (framepop-display-buffer buf)))))))) + + 'around + 'last) + (ad-activate function)) + +(defun framepop-submit-feedback () + "Sumbit feedback on the FramePop package by electronic mail." + (interactive) + (require 'reporter) + (reporter-submit-bug-report + "Peter S Galbraith " + (concat "framepop.el; version " framepop-version) + '(framepop-lines framepop-auto-resize framepop-frame-parameters))) + +;;; Special display +;;; --------------- + +(defun framepop-special-display (buffer &optional args) + "Display BUF in the FramePop frame. +Pass it BUFFER as first arg, and (cdr ARGS) gives the rest of the args. +If ARGS is a list whose car is a symbol, use (car ARGS) as a function +to do the work. +Otherwise, ARGS is ignored." + (if (and args (symbolp (car args))) + (apply (car args) buffer (cdr args)) + (framepop-display-buffer buffer) + (frame-selected-window framepop-frame))) + +;;; Customizations using advice +;;; --------------------------- + +;;; There are lots of useful things we can do with advice, but I +;;; really want to avoid forcing everyone to load the advice package +;;; just for framepop (advice is BIG). So here's a compromise: If +;;; advice has been loaded, the customizations below will be made. + +(if (or (equal framepop-use-advice t) + (and (equal framepop-use-advice 'automatic) + (featurep 'advice))) + (progn + + ;; (setq ad-activate-on-definition t) ; allow forward advice + ;; (ad-start-advice) ; make forward advice work + +;;; Without the following advice, any completions generated by comint +;;; will leave the focus in the framepop frame (ugh) + + (defadvice comint-dynamic-list-completions (around framepop-simple-complete activate) + "Just display the completions buffer; no fancy tricks, OK?" + (with-output-to-temp-buffer "*Completions*" + (display-completion-list (sort completions 'string-lessp)))) + +;;; You may use the function framepop-wrap to force buffers which do +;;; not normally appear in a FramePop frame to do so automatically. For +;;; example, the following commands force *Shell Command Output* +;;; buffers to appear in the FramePop frame: + +;; This is better done with special-display-buffer-names, so I've disabled it +;; (framepop-wrap 'shell-command "*Shell Command Output*") +;; (framepop-wrap 'shell-command-on-region "*Shell Command Output*") + +;;; You can also do this for the compile function, as shown below. In +;;; addition we also add the following advice to work around the +;;; strange way compile displays its windows: + +;; This is better done with special-display-buffer-names, so I've disabled it +;; (framepop-wrap 'compile "*compilation*") +;; (framepop-wrap 'grep "*grep*") + +;;; The above advised functions are part of compile.el, which is +;;; autoloaded. We need to activate these advices after compile.el has +;;; loaded. + +;; (eval-after-load "compile" +;; '(progn +;; (ad-activate 'compile) +;; (ad-activate 'grep) +;; (ad-activate 'compile-internal) +;; (ad-activate 'compile-goto-error))) + +;;; Under normal (i.e. without framepop) circumstances, completion +;;; buffers disappear after use. The following advice similarly +;;; arranges for a framepop frame displaying completions to get out of +;;; the way after use. Other choices here include +;;; framepop-make-invisible-frame or framepop-lower-frame + + (defun framepop-completions-buffer-p nil + ;; Return non-nil if the framepop buffer is a completions buffer + (let ((buf (framepop-buffer))) + (and buf + (string-match "[cC]ompletions" (buffer-name buf))))) + + (defvar framepop-go-away-function 'framepop-iconify-frame + "*Function called to make the framepop frame go away") + + (defun framepop-maybe-go-away (&optional force) + ;; Get rid of the framepop frame if it shows completions buffer + (if (or force (framepop-completions-buffer-p)) + (funcall framepop-go-away-function))) + + (defadvice completing-read (after framepop-go-away protect activate) + "Get rid of the FramePop frame showing the completions" + (framepop-maybe-go-away)) + + ;; It would seem we only need protected advice for + ;; completing-read, but that subr is often called from other + ;; subrs and advice won't work. The following advices get around + ;; some of the cases where this happens, but unfortunately in + ;; such cases C-g won't lower the framepop frame, as desired. + + (defadvice minibuffer-complete-and-exit (before framepop-go-away + activate) + "Get rid of the FramePop frame showing the completions" + (framepop-maybe-go-away)) + + (defadvice exit-minibuffer (before framepop-go-away activate) + "Get rid of the FramePop frame showing the completions" + (framepop-maybe-go-away)) + + (defadvice mouse-choose-completion (after framepop-go-away activate) + "Get rid of the FramePop frame showing the completions" + (framepop-maybe-go-away t)) + + (defadvice keyboard-quit (before framepop-go-away activate) + "Get rid of the FramePop frame showing the completions" + (framepop-maybe-go-away)) + + (defadvice abort-recursive-edit (before framepop-go-away activate) + "Get rid of the FramePop frame showing the completions" + (framepop-maybe-go-away)) + +;;; End of advice customizations + )) + +(provide 'framepop) + +;;; framepop.el ends here diff --git a/elisp/emacs-goodies-el/graphviz-dot-mode.el b/elisp/emacs-goodies-el/graphviz-dot-mode.el new file mode 100755 index 0000000..6044810 --- /dev/null +++ b/elisp/emacs-goodies-el/graphviz-dot-mode.el @@ -0,0 +1,944 @@ +;;; graphviz-dot-mode.el --- Mode for the dot-language used by graphviz (att). + +;; Copyright (C) 2002 - 2010 Pieter Pareit + +;; 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 + +;; Authors: Pieter Pareit +;; Rubens Ramos +;; Eric Anderson http://www.ece.cmu.edu/~andersoe/ +;; Maintainer: Pieter Pareit +;; Homepage: http://users.skynet.be/ppareit/projects/graphviz-dot-mode/graphviz-dot-mode.html +;; Created: 28 Oct 2002 +;; Last modified: 19 feb 2011 +;; Version: 0.3.6 +;; Keywords: mode dot dot-language dotlanguage graphviz graphs att + +;;; Commentary: +;; Use this mode for editing files in the dot-language (www.graphviz.org and +;; http://www.research.att.com/sw/tools/graphviz/). +;; +;; To use graphviz-dot-mode, add +;; (load-file "PATH_TO_FILE/graphviz-dot-mode.el") +;; to your ~/.emacs(.el) or ~/.xemacs/init.el +;; +;; The graphviz-dot-mode will do font locking, indentation, preview of graphs +;; and eases compilation/error location. There is support for both GNU Emacs +;; and XEmacs. +;; +;; Font locking is automatic, indentation uses the same commands as +;; other modes, tab, M-j and C-M-q. Insertion of comments uses the +;; same commands as other modes, M-; . You can compile a file using +;; M-x compile or C-c c, after that M-x next-error will also work. +;; There is support for viewing an generated image with C-c p. + +;;; Todo: +;; * cleanup the mess of graphviz-dot-compilation-parse-errors. +;; * electric indentation is fundamentally broken, because +;; {...} are also used for record nodes. You could argue, I suppose, that +;; many diagrams don't need those, but it would be worth having a note (and +;; it makes sense that the default is now for electric indentation to be +;; off). +;; * lines that start with # are comments, lines that start with one or more +;; whitespaces and then a # should give an error. + +;;; History: + +;; Version 0.3.6 maintaince +;; 19/02/2011: * .gv is the new extension (Pander) +;; * comments can start with # (Pander) +;; * highlight of new keywords (Pander) +;; Version 0.3.5 bug (or at least feature I dislike) fix +;; 11/11/2010: Eric Anderson http://www.ece.cmu.edu/~andersoe/ +;; * Preserve indentation across blank (whitespace-only) lines +;; Version 0.3.4 bug fixes +;; 24/02/2005: * fixed a bug in graphviz-dot-preview +;; Version 0.3.3 bug fixes +;; 13/02/2005: Reuben Thomas +;; * add graphviz-dot-indent-width +;; Version 0.3.2 bug fixes +;; 25/03/2004: Rubens Ramos +;; * semi-colons and brackets are added when electric +;; behaviour is disabled. +;; * electric characters do not behave electrically inside +;; comments or strings. +;; * default for electric-braces is disabled now (makes more +;; sense I guess). +;; * using read-from-minibuffer instead of read-shell-command +;; for emacs. +;; * Fixed test for easymenu, so that it works on older +;; versions of XEmacs. +;; * Fixed indentation error when trying to indent last brace +;; of an empty graph. +;; * region-active-p does not exist in emacs (21.2 at least), +;; so removed from code +;; * Added uncomment menu option +;; Version 0.3.1 bug fixes +;; 03/03/2004: * backward-word needs argument for older emacs +;; Version 0.3 added features and fixed bugs +;; 10/01/2004: fixed a bug in graphviz-dot-indent-graph +;; 08/01/2004: Rubens Ramos +;; * added customization support +;; * Now it works on XEmacs and Emacs +;; * Added support to use an external Viewer +;; * Now things do not break when dot mode is entered +;; when there is no buffer name, but the side effect is +;; that in this case, the compilation command is not +;; correct. +;; * Preview works on XEmacs and emacs. +;; * Electric indentation on newline +;; * Minor changes to indentation +;; * Added keyword completion (but could be A LOT better) +;; * There are still a couple of ugly hacks. Look for 'RR'. +;; Version 0.2 added features +;; 11/11/2002: added preview support. +;; 10/11/2002: indent a graph or subgraph at once with C-M-q. +;; 08/11/2002: relaxed rules for indentation, the may now be extra chars +;; after beginning of graph (comment's for example). +;; Version 0.1.2 bug fixes and naming issues +;; 06/11/2002: renamed dot-font-lock-defaults to dot-font-lock-keywords. +;; added some documentation to dot-colors. +;; provided a much better way to handle my max-specpdl-size +;; problem. +;; added an extra autoload cookie (hope this helps, as I don't +;; yet use autoload myself) +;; Version 0.1.1 bug fixes +;; 06/11/2002: added an missing attribute, for font-locking to work. +;; fixed the regex generating, so that it only recognizes +;; whole words +;; 05/11/2002: there can now be extra white space chars after an '{'. +;; 04/11/2002: Why I use max-specpdl-size is now documented, and old value +;; gets restored. +;; Version 0.1 initial release +;; 02/11/2002: implemented parser for *compilation* of a .dot file. +;; 01/11/2002: implemented compilation of an .dot file. +;; 31/10/2002: added syntax-table to the mode. +;; 30/10/2002: implemented indentation code. +;; 29/10/2002: implemented all of font-lock. +;; 28/10/2002: derived graphviz-dot-mode from fundamental-mode, started +;; implementing font-lock. + +;;; Code: + +(defconst graphviz-dot-mode-version "0.3.6" + "Version of `graphviz-dot-mode.el'.") + +(defgroup graphviz nil + "Major mode for editing Graphviz Dot files" + :group 'tools) + +(defun graphviz-dot-customize () + "Run \\[customize-group] for the `graphviz' group." + (interactive) + (customize-group 'graphviz)) + +(defvar graphviz-dot-mode-abbrev-table nil + "Abbrev table in use in Graphviz Dot mode buffers.") +(define-abbrev-table 'graphviz-dot-mode-abbrev-table ()) + +(defcustom graphviz-dot-dot-program "dot" + "*Location of the dot program. This is used by `compile'." + :type 'string + :group 'graphviz) + +(defcustom graphviz-dot-view-command "doted %s" + "*External program to run on the buffer. You can use `%s' in this string, +and it will be substituted by the buffer name." + :type 'string + :group 'graphviz) + +(defcustom graphviz-dot-view-edit-command nil + "*Whether to allow the user to edit the command to run an external +viewer." + :type 'boolean + :group 'graphviz) + +(defcustom graphviz-dot-save-before-view t + "*If not nil, M-x graphviz-dot-view saves the current buffer before running +the command." + :type 'boolean + :group 'graphviz) + +(defcustom graphviz-dot-auto-indent-on-newline t + "*If not nil, `electric-graphviz-dot-terminate-line' is executed in a line is terminated." + :type 'boolean + :group 'graphviz) + +(defcustom graphviz-dot-indent-width default-tab-width + "*Indentation width in Graphviz Dot mode buffers." + :type 'integer + :group 'graphviz) + +(defcustom graphviz-dot-auto-indent-on-braces nil + "*If not nil, `electric-graphviz-dot-open-brace' and `electric-graphviz-dot-close-brace' are executed when { or } are typed" + :type 'boolean + :group 'graphviz) + +(defcustom graphviz-dot-auto-indent-on-semi t + "*If not nil, `electric-graphviz-dot-semi' is executed when semicolon is typed" + :type 'boolean + :group 'graphviz) + +(defcustom graphviz-dot-preview-extension "png" + "*The extension to use for the compilation and preview commands. The format +for the compilation command is +`dot -T file.dot > file.'." + :type 'string + :group 'graphviz) + +(defcustom graphviz-dot-toggle-completions nil + "*Non-nil means that repeated use of \ +\\\\[graphviz-dot-complete-word] will toggle the possible +completions in the minibuffer. Normally, when there is more than one possible +completion, a buffer will display all completions." + :type 'boolean + :group 'graphviz) + +(defcustom graphviz-dot-delete-completions nil + "*Non-nil means that the completion buffer is automatically deleted when a +key is pressed." + :type 'boolean + :group 'graphviz) + +(defcustom graphviz-dot-attr-keywords + '("graph" "digraph" "subgraph" "node" "edge" "strict" "rankdir" + "size" "page" "Damping" "Epsilon" "URL" "arrowhead" "arrowsize" + "arrowtail" "bb" "bgcolor" "bottomlabel" "center" "clusterrank" + "color" "comment" "compound" "concentrate" "constraint" "decorate" + "dim" "dir" "distortion" "fillcolor" "fixedsize" "fontcolor" + "fontname" "fontpath" "fontsize" "group" "headURL" "headlabel" + "headport" "height" "label" "labelangle" "labeldistance" "labelfloat" + "labelfontcolor" "labelfontname" "labelfontsize" "labeljust" + "labelloc" "layer" "layers" "len" "lhead" "lp" "ltail" "margin" + "maxiter" "mclimit" "minlen" "model" "nodesep" "normalize" "nslimit" + "nslimit1" "ordering" "orientation" "overlap" "pack" "pagedir" + "pencolor" "peripheries" "pin" "pos" "quantum" "rank" "ranksep" + "ratio" "rects" "regular" "remincross" "rotate" "samehead" "sametail" + "samplepoint" "searchsize" "sep" "shape" "shapefile" "showboxes" + "sides" "skew" "splines" "start" "style" "stylesheet" "tailURL" + "taillabel" "tailport" "toplabel" "vertices" "voro_margin" "weight" + "z" "width" "penwidth" "mindist" "scale" "patch" "root") + "*Keywords for attribute names in a graph. This is used by the auto +completion code. The actual completion tables are built when the mode +is loaded, so changes to this are not immediately visible. +Check http://www.graphviz.org/doc/schema/attributes.xml on new releases." + :type '(repeat (string :tag "Keyword")) + :group 'graphviz) + +(defcustom graphviz-dot-value-keywords + '("true" "false" "normal" "inv" "dot" "invdot" "odot" "invodot" + "none" "tee" "empty" "invempty" "diamond" "odiamond" "box" "obox" + "open" "crow" "halfopen" "local" "global" "none" "forward" "back" + "both" "none" "BL" "BR" "TL" "TR" "RB" "RT" "LB" "LT" ":n" ":ne" ":e" + ":se" ":s" ":sw" ":w" ":nw" "same" "min" "source" "max" "sink" "LR" + "box" "polygon" "ellipse" "circle" "point" "egg" "triangle" + "plaintext" "diamond" "trapezium" "parallelogram" "house" "hexagon" + "octagon" "doublecircle" "doubleoctagon" "tripleoctagon" "invtriangle" + "invtrapezium" "invhouse" "Mdiamond" "Msquare" "Mcircle" "record" + "Mrecord" "dashed" "dotted" "solid" "invis" "bold" "filled" + "diagonals" "rounded" ) + "*Keywords for attribute values. This is used by the auto completion +code. The actual completion tables are built when the mode is loaded, +so changes to this are not immediately visible." + :type '(repeat (string :tag "Keyword")) + :group 'graphviz) + +;;; Font-locking: +(defvar graphviz-dot-colors-list + '(aliceblue antiquewhite antiquewhite1 antiquewhite2 + antiquewhite3 antiquewhite4 aquamarine aquamarine1 + aquamarine2 aquamarine3 aquamarine4 azure azure1 + azure2 azure3 azure4 beige bisque bisque1 bisque2 + bisque3 bisque4 black blanchedalmond blue blue1 + blue2 blue3 blue4 blueviolet brown brown1 brown2 + brown3 brown4 burlywood burlywood1 burlywood2 + burlywood3 burlywood4 cadetblue cadetblue1 + cadetblue2 cadetblue3 cadetblue4 chartreuse + chartreuse1 chartreuse2 chartreuse3 chartreuse4 + chocolate chocolate1 chocolate2 chocolate3 chocolate4 + coral coral1 coral2 coral3 coral4 cornflowerblue + cornsilk cornsilk1 cornsilk2 cornsilk3 cornsilk4 + crimson cyan cyan1 cyan2 cyan3 cyan4 darkgoldenrod + darkgoldenrod1 darkgoldenrod2 darkgoldenrod3 + darkgoldenrod4 darkgreen darkkhaki darkolivegreen + darkolivegreen1 darkolivegreen2 darkolivegreen3 + darkolivegreen4 darkorange darkorange1 darkorange2 + darkorange3 darkorange4 darkorchid darkorchid1 + darkorchid2 darkorchid3 darkorchid4 darksalmon + darkseagreen darkseagreen1 darkseagreen2 + darkseagreen3 darkseagreen4 darkslateblue + darkslategray darkslategray1 darkslategray2 + darkslategray3 darkslategray4 darkslategrey + darkturquoise darkviolet deeppink deeppink1 + deeppink2 deeppink3 deeppink4 deepskyblue + deepskyblue1 deepskyblue2 deepskyblue3 deepskyblue4 + dimgray dimgrey dodgerblue dodgerblue1 dodgerblue2 + dodgerblue3 dodgerblue4 firebrick firebrick1 + firebrick2 firebrick3 firebrick4 floralwhite + forestgreen gainsboro ghostwhite gold gold1 gold2 + gold3 gold4 goldenrod goldenrod1 goldenrod2 + goldenrod3 goldenrod4 gray gray0 gray1 gray10 gray100 + gray11 gray12 gray13 gray14 gray15 gray16 gray17 + gray18 gray19 gray2 gray20 gray21 gray22 gray23 + gray24 gray25 gray26 gray27 gray28 gray29 gray3 + gray30 gray31 gray32 gray33 gray34 gray35 gray36 + gray37 gray38 gray39 gray4 gray40 gray41 gray42 + gray43 gray44 gray45 gray46 gray47 gray48 gray49 + gray5 gray50 gray51 gray52 gray53 gray54 gray55 + gray56 gray57 gray58 gray59 gray6 gray60 gray61 + gray62 gray63 gray64 gray65 gray66 gray67 gray68 + gray69 gray7 gray70 gray71 gray72 gray73 gray74 + gray75 gray76 gray77 gray78 gray79 gray8 gray80 + gray81 gray82 gray83 gray84 gray85 gray86 gray87 + gray88 gray89 gray9 gray90 gray91 gray92 gray93 + gray94 gray95 gray96 gray97 gray98 gray99 green + green1 green2 green3 green4 greenyellow grey grey0 + grey1 grey10 grey100 grey11 grey12 grey13 grey14 + grey15 grey16 grey17 grey18 grey19 grey2 grey20 + grey21 grey22 grey23 grey24 grey25 grey26 grey27 + grey28 grey29 grey3 grey30 grey31 grey32 grey33 + grey34 grey35 grey36 grey37 grey38 grey39 grey4 + grey40 grey41 grey42 grey43 grey44 grey45 grey46 + grey47 grey48 grey49 grey5 grey50 grey51 grey52 + grey53 grey54 grey55 grey56 grey57 grey58 grey59 + grey6 grey60 grey61 grey62 grey63 grey64 grey65 + grey66 grey67 grey68 grey69 grey7 grey70 grey71 + grey72 grey73 grey74 grey75 grey76 grey77 grey78 + grey79 grey8 grey80 grey81 grey82 grey83 grey84 + grey85 grey86 grey87 grey88 grey89 grey9 grey90 + grey91 grey92 grey93 grey94 grey95 grey96 grey97 + grey98 grey99 honeydew honeydew1 honeydew2 honeydew3 + honeydew4 hotpink hotpink1 hotpink2 hotpink3 hotpink4 + indianred indianred1 indianred2 indianred3 indianred4 + indigo ivory ivory1 ivory2 ivory3 ivory4 khaki khaki1 + khaki2 khaki3 khaki4 lavender lavenderblush + lavenderblush1 lavenderblush2 lavenderblush3 + lavenderblush4 lawngreen lemonchiffon lemonchiffon1 + lemonchiffon2 lemonchiffon3 lemonchiffon4 lightblue + lightblue1 lightblue2 lightblue3 lightblue4 + lightcoral lightcyan lightcyan1 lightcyan2 lightcyan3 + lightcyan4 lightgoldenrod lightgoldenrod1 + lightgoldenrod2 lightgoldenrod3 lightgoldenrod4 + lightgoldenrodyellow lightgray lightgrey lightpink + lightpink1 lightpink2 lightpink3 lightpink4 + lightsalmon lightsalmon1 lightsalmon2 lightsalmon3 + lightsalmon4 lightseagreen lightskyblue lightskyblue1 + lightskyblue2 lightskyblue3 lightskyblue4 + lightslateblue lightslategray lightslategrey + lightsteelblue lightsteelblue1 lightsteelblue2 + lightsteelblue3 lightsteelblue4 lightyellow + lightyellow1 lightyellow2 lightyellow3 lightyellow4 + limegreen linen magenta magenta1 magenta2 magenta3 + magenta4 maroon maroon1 maroon2 maroon3 maroon4 + mediumaquamarine mediumblue mediumorchid + mediumorchid1 mediumorchid2 mediumorchid3 + mediumorchid4 mediumpurple mediumpurple1 + mediumpurple2 mediumpurple3 mediumpurple4 + mediumseagreen mediumslateblue mediumspringgreen + mediumturquoise mediumvioletred midnightblue + mintcream mistyrose mistyrose1 mistyrose2 mistyrose3 + mistyrose4 moccasin navajowhite navajowhite1 + navajowhite2 navajowhite3 navajowhite4 navy navyblue + oldlace olivedrab olivedrap olivedrab1 olivedrab2 + olivedrap3 oragne palegoldenrod palegreen palegreen1 + palegreen2 palegreen3 palegreen4 paleturquoise + paleturquoise1 paleturquoise2 paleturquoise3 + paleturquoise4 palevioletred palevioletred1 + palevioletred2 palevioletred3 palevioletred4 + papayawhip peachpuff peachpuff1 peachpuff2 + peachpuff3 peachpuff4 peru pink pink1 pink2 pink3 + pink4 plum plum1 plum2 plum3 plum4 powderblue + purple purple1 purple2 purple3 purple4 red red1 red2 + red3 red4 rosybrown rosybrown1 rosybrown2 rosybrown3 + rosybrown4 royalblue royalblue1 royalblue2 royalblue3 + royalblue4 saddlebrown salmon salmon1 salmon2 salmon3 + salmon4 sandybrown seagreen seagreen1 seagreen2 + seagreen3 seagreen4 seashell seashell1 seashell2 + seashell3 seashell4 sienna sienna1 sienna2 sienna3 + sienna4 skyblue skyblue1 skyblue2 skyblue3 skyblue4 + slateblue slateblue1 slateblue2 slateblue3 slateblue4 + slategray slategray1 slategray2 slategray3 slategray4 + slategrey snow snow1 snow2 snow3 snow4 springgreen + springgreen1 springgreen2 springgreen3 springgreen4 + steelblue steelblue1 steelblue2 steelblue3 steelblue4 + tan tan1 tan2 tan3 tan4 thistle thistle1 thistle2 + thistle3 thistle4 tomato tomato1 tomato2 tomato3 + tomato4 transparent turquoise turquoise1 turquoise2 + turquoise3 turquoise4 violet violetred violetred1 + violetred2 violetred3 violetred4 wheat wheat1 wheat2 + wheat3 wheat4 white whitesmoke yellow yellow1 yellow2 + yellow3 yellow4 yellowgreen) + "Possible color constants in the dot language. +The list of constant is available at http://www.research.att.com/~erg/graphviz\ +/info/colors.html") + + +(defvar graphviz-dot-color-keywords + (mapcar 'symbol-name graphviz-dot-colors-list)) + +(defvar graphviz-attr-keywords + (mapcar '(lambda (elm) (cons elm 0)) graphviz-dot-attr-keywords)) + +(defvar graphviz-value-keywords + (mapcar '(lambda (elm) (cons elm 0)) graphviz-dot-value-keywords)) + +(defvar graphviz-color-keywords + (mapcar '(lambda (elm) (cons elm 0)) graphviz-dot-color-keywords)) + +;;; Key map +(defvar graphviz-dot-mode-map () + "Keymap used in Graphviz Dot mode.") + +(if graphviz-dot-mode-map + () + (let ((map (make-sparse-keymap))) + (define-key map "\r" 'electric-graphviz-dot-terminate-line) + (define-key map "{" 'electric-graphviz-dot-open-brace) + (define-key map "}" 'electric-graphviz-dot-close-brace) + (define-key map ";" 'electric-graphviz-dot-semi) + (define-key map "\M-\t" 'graphviz-dot-complete-word) + (define-key map "\C-\M-q" 'graphviz-dot-indent-graph) + (define-key map "\C-cp" 'graphviz-dot-preview) + (define-key map "\C-cc" 'compile) + (define-key map "\C-cv" 'graphviz-dot-view) + (define-key map "\C-c\C-c" 'comment-region) + (define-key map "\C-c\C-u" 'graphviz-dot-uncomment-region) + (setq graphviz-dot-mode-map map) + )) + +;;; Syntax table +(defvar graphviz-dot-mode-syntax-table nil + "Syntax table for `graphviz-dot-mode'.") + +(if graphviz-dot-mode-syntax-table + () + (let ((st (make-syntax-table))) + (modify-syntax-entry ?/ ". 124b" st) + (modify-syntax-entry ?* ". 23" st) + (modify-syntax-entry ?\n "> b" st) + (modify-syntax-entry ?= "." st) + (modify-syntax-entry ?_ "_" st) + (modify-syntax-entry ?- "_" st) + (modify-syntax-entry ?> "." st) + (modify-syntax-entry ?[ "(" st) + (modify-syntax-entry ?] ")" st) + (modify-syntax-entry ?\" "\"" st) + (setq graphviz-dot-mode-syntax-table st) + )) + +(defvar graphviz-dot-font-lock-keywords + `(("\\(:?di\\|sub\\)?graph \\(\\sw+\\)" + (2 font-lock-function-name-face)) + (,(regexp-opt graphviz-dot-value-keywords 'words) + . font-lock-reference-face) + ;; to build the font-locking for the colors, + ;; we need more room for max-specpdl-size, + ;; after that we take the list of symbols, + ;; convert them to a list of strings, and make + ;; an optimized regexp from them + (,(let ((max-specpdl-size (max max-specpdl-size 1200))) + (regexp-opt graphviz-dot-color-keywords)) + . font-lock-string-face) + (,(concat + (regexp-opt graphviz-dot-attr-keywords 'words) + "[ \\t\\n]*=") + ;; RR - ugly, really, but I dont know why xemacs does not work + ;; if I change the next car to "1"... + (0 font-lock-variable-name-face))) + "Keyword highlighting specification for `graphviz-dot-mode'.") + +;;;###autoload +(defun graphviz-dot-mode () + "Major mode for the dot language. \\ +TAB indents for graph lines. + +\\[graphviz-dot-indent-graph]\t- Indentaion function. +\\[graphviz-dot-preview]\t- Previews graph in a buffer. +\\[graphviz-dot-view]\t- Views graph in an external viewer. +\\[graphviz-dot-indent-line]\t- Indents current line of code. +\\[graphviz-dot-complete-word]\t- Completes the current word. +\\[electric-graphviz-dot-terminate-line]\t- Electric newline. +\\[electric-graphviz-dot-open-brace]\t- Electric open braces. +\\[electric-graphviz-dot-close-brace]\t- Electric close braces. +\\[electric-graphviz-dot-semi]\t- Electric semi colons. + +Variables specific to this mode: + + graphviz-dot-dot-program (default `dot') + Location of the dot program. + graphviz-dot-view-command (default `doted %s') + Command to run when `graphviz-dot-view' is executed. + graphviz-dot-view-edit-command (default nil) + If the user should be asked to edit the view command. + graphviz-dot-save-before-view (default t) + Automatically save current buffer berore `graphviz-dot-view'. + graphviz-dot-preview-extension (default `png') + File type to use for `graphviz-dot-preview'. + graphviz-dot-auto-indent-on-newline (default t) + Whether to run `electric-graphviz-dot-terminate-line' when + newline is entered. + graphviz-dot-auto-indent-on-braces (default t) + Whether to run `electric-graphviz-dot-open-brace' and + `electric-graphviz-dot-close-brace' when braces are + entered. + graphviz-dot-auto-indent-on-semi (default t) + Whether to run `electric-graphviz-dot-semi' when semi colon + is typed. + graphviz-dot-toggle-completions (default nil) + If completions should be displayed in the buffer instead of a + completion buffer when \\[graphviz-dot-complete-word] is + pressed repeatedly. + +This mode can be customized by running \\[graphviz-dot-customize]. + +Turning on Graphviz Dot mode calls the value of the variable +`graphviz-dot-mode-hook' with no args, if that value is non-nil." + (interactive) + (kill-all-local-variables) + (use-local-map graphviz-dot-mode-map) + (setq major-mode 'graphviz-dot-mode) + (setq mode-name "dot") + (setq local-abbrev-table graphviz-dot-mode-abbrev-table) + (set-syntax-table graphviz-dot-mode-syntax-table) + (set (make-local-variable 'indent-line-function) 'graphviz-dot-indent-line) + (set (make-local-variable 'comment-start) "//") + (set (make-local-variable 'comment-start-skip) "/\\*+ *\\|//+ *") + (modify-syntax-entry ?# "< b" graphviz-dot-mode-syntax-table) + (modify-syntax-entry ?\n "> b" graphviz-dot-mode-syntax-table) + (set (make-local-variable 'font-lock-defaults) + '(graphviz-dot-font-lock-keywords)) + ;; RR - If user is running this in the scratch buffer, there is no + ;; buffer file name... + (if (buffer-file-name) + (set (make-local-variable 'compile-command) + (concat graphviz-dot-dot-program + " -T" graphviz-dot-preview-extension " " + buffer-file-name + " > " + (file-name-sans-extension + buffer-file-name) + "." graphviz-dot-preview-extension))) + (set (make-local-variable 'compilation-parse-errors-function) + 'graphviz-dot-compilation-parse-errors) + (if dot-menu + (easy-menu-add dot-menu)) + (run-hooks 'graphviz-dot-mode-hook) + ) + +;;;; Menu definitions + +(defvar dot-menu nil + "Menu for Graphviz Dot Mode. +This menu will get created automatically if you have the `easymenu' +package. Note that the latest X/Emacs releases contain this package.") + +(and (condition-case nil + (require 'easymenu) + (error nil)) + (easy-menu-define + dot-menu graphviz-dot-mode-map "Graphviz Mode menu" + '("Graphviz" + ["Indent Graph" graphviz-dot-indent-graph t] + ["Comment Out Region" comment-region (mark)] + ["Uncomment Region" graphviz-dot-uncomment-region (mark)] + "-" + ["Compile" compile t] + ["Preview" graphviz-dot-preview + (and (buffer-file-name) + (not (buffer-modified-p)))] + ["External Viewer" graphviz-dot-view (buffer-file-name)] + "-" + ["Customize..." graphviz-dot-customize t] + ))) + +;;;; Compilation + +;; note on graphviz-dot-compilation-parse-errors: +;; It would nicer if we could just use compilation-error-regexp-alist +;; to do that, 3 options: +;; - still write dot-compilation-parse-errors, don't build +;; a return list, but modify the *compilation* buffer +;; in a way compilation-error-regexp-alist recognizes the +;; format. +;; to do that, I should globally change compilation-parse-function +;; to this function, and call the old value of comp..-parse-fun.. +;; to provide the return value. +;; two drawbacks are that, every compilation would be run through +;; this function (performance) and that in autoload there would +;; be a chance that this function would not yet be known. +;; - let the compilation run through a filter that would +;; modify the output of dot or neato: +;; dot -Tpng input.dot | filter +;; drawback: ugly, extra work for user, extra decency ... +;; no-option +;; - modify dot and neato !!! (PP:15/02/2005 seems to have happend, +;; so version 0.4.0 should clean this mess up!) +(defun graphviz-dot-compilation-parse-errors (limit-search find-at-least) + "Parse the current buffer for dot errors. +See variable `compilation-parse-errors-functions' for interface." + (interactive) + (save-excursion + (set-buffer "*compilation*") + (goto-char (point-min)) + (setq compilation-error-list nil) + (let (buffer-of-error) + (while (not (eobp)) + (cond + ((looking-at "^dot\\( -[^ ]+\\)* \\(.*\\)") + (setq buffer-of-error (find-file-noselect + (buffer-substring-no-properties + (nth 4 (match-data t)) + (nth 5 (match-data t)))))) + ((looking-at ".*:.*line \\([0-9]+\\)") + (let ((line-of-error + (string-to-number (buffer-substring-no-properties + (nth 2 (match-data t)) + (nth 3 (match-data t)))))) + (setq compilation-error-list + (cons + (cons + (point-marker) + (save-excursion + (set-buffer buffer-of-error) + (goto-line line-of-error) + (beginning-of-line) + (point-marker))) + compilation-error-list)))) + (t t)) + (forward-line 1)) ))) + +;;;; +;;;; Indentation +;;;; +(defun graphviz-dot-uncomment-region (begin end) + "Uncomments a region of code." + (interactive "r") + (comment-region begin end '(4))) + +(defun graphviz-dot-indent-line () + "Indent current line of dot code." + (interactive) + (if (bolp) + (graphviz-dot-real-indent-line) + (save-excursion + (graphviz-dot-real-indent-line)))) + +(defun graphviz-dot-get-indendation() + "Return current line's indentation" + (interactive) + (message "Current indentation is %d." + (current-indentation)) + (current-indentation)) + +(defun graphviz-dot-real-indent-line () + "Indent current line of dot code." + (beginning-of-line) + (cond + ((bobp) + ;; simple case, indent to 0 + (indent-line-to 0)) + ((looking-at "^[ \t]*}[ \t]*$") + ;; block closing, deindent relative to previous line + (indent-line-to (save-excursion + (forward-line -1) + (max 0 (- (current-indentation) graphviz-dot-indent-width))))) + ;; other cases need to look at previous lines + (t + (indent-line-to (save-excursion + (forward-line -1) + (cond + ((looking-at "\\(^.*{[^}]*$\\)") + ;; previous line opened a block + ;; indent to that line + (+ (current-indentation) graphviz-dot-indent-width)) + ((and (not (looking-at ".*\\[.*\\].*")) + (looking-at ".*\\[.*")) ; TODO:PP : can be 1 regex + ;; previous line started filling + ;; attributes, intend to that start + (search-forward "[") + (current-column)) + ((and (not (looking-at ".*\\[.*\\].*")) + (looking-at ".*\\].*")) ; TODO:PP : " + ;; previous line stopped filling + ;; attributes, find the line that started + ;; filling them and indent to that line + (while (or (looking-at ".*\\[.*\\].*") + (not (looking-at ".*\\[.*"))) ; TODO:PP : " + (forward-line -1)) + (current-indentation)) + (t + ;; default case, indent the + ;; same as previous NON-BLANK line + ;; (or the first line, if there are no previous non-blank lines) + (while (and (< (point-min) (point)) + (looking-at "^\[ \t\]*$")) + (forward-line -1)) + (current-indentation)) ))) ))) + +(defun graphviz-dot-indent-graph () + "Indent the graph/digraph/subgraph where point is at. +This will first teach the beginning of the graph were point is at, and +then indent this and each subgraph in it." + (interactive) + (save-excursion + ;; position point at start of graph + (while (not (or (looking-at "\\(^.*{[^}]*$\\)") (bobp))) + (forward-line -1)) + ;; bracket { one +; bracket } one - + (let ((bracket-count 0)) + (while + (progn + (cond + ;; update bracket-count + ((looking-at "\\(^.*{[^}]*$\\)") + (setq bracket-count (+ bracket-count 1))) + ;; update bracket-count + ((looking-at "^[ \t]*}[ \t]*$") + (setq bracket-count (- bracket-count 1)))) + ;; indent this line and move on + (graphviz-dot-indent-line) + (forward-line 1) + ;; as long as we are not completed or at end of buffer + (and (> bracket-count 0) (not (eobp)))))))) + +;;;; +;;;; Electric indentation +;;;; +(defun graphviz-dot-comment-or-string-p () + (let ((state (parse-partial-sexp (point-min) (point)))) + (or (nth 4 state) (nth 3 state)))) + +(defun graphviz-dot-newline-and-indent () + (save-excursion + (beginning-of-line) + (skip-chars-forward " \t") + (graphviz-dot-indent-line)) + (delete-horizontal-space) + (newline) + (graphviz-dot-indent-line)) + +(defun electric-graphviz-dot-terminate-line () + "Terminate line and indent next line." + (interactive) + (if graphviz-dot-auto-indent-on-newline + (graphviz-dot-newline-and-indent) + (newline))) + +(defun electric-graphviz-dot-open-brace () + "Terminate line and indent next line." + (interactive) + (insert "{") + (if (and graphviz-dot-auto-indent-on-braces + (not (graphviz-dot-comment-or-string-p))) + (graphviz-dot-newline-and-indent))) + +(defun electric-graphviz-dot-close-brace () + "Terminate line and indent next line." + (interactive) + (insert "}") + (if (and graphviz-dot-auto-indent-on-braces + (not (graphviz-dot-comment-or-string-p))) + (progn + (save-excursion + (beginning-of-line) + (skip-chars-forward " \t") + (graphviz-dot-indent-line)) + (newline) + (graphviz-dot-indent-line)))) + +(defun electric-graphviz-dot-semi () + "Terminate line and indent next line." + (interactive) + (insert ";") + (if (and graphviz-dot-auto-indent-on-semi + (not (graphviz-dot-comment-or-string-p))) + (graphviz-dot-newline-and-indent))) + +;;;; +;;;; Preview +;;;; +(defun graphviz-dot-preview () + "Shows an example of the current dot file in an emacs buffer. +This assumes that we are running GNU Emacs or XEmacs under a windowing system. +See `image-file-name-extensions' for customizing the files that can be +loaded in GNU Emacs, and `image-formats-alist' for XEmacs." + (interactive) + ;; unsafe to compile ourself, ask it to the user + (if (buffer-modified-p) + (message "Buffer needs to be compiled.") + (if (string-match "XEmacs" emacs-version) + ;; things are easier in XEmacs... + (find-file-other-window (concat (file-name-sans-extension + buffer-file-name) + "." graphviz-dot-preview-extension)) + ;; run through all the extensions for images + (let ((l image-file-name-extensions)) + (while + (let ((f (concat (file-name-sans-extension (buffer-file-name)) + "." + (car l)))) + ;; see if a file matches, might be best also to check + ;; if file is up to date TODO:PP + (if (file-exists-p f) + (progn (auto-image-file-mode 1) + ;; OK, this is ugly, I would need to + ;; know how I can reload a file in an existing buffer + (if (get-buffer "*preview*") + (kill-buffer "*preview*")) + (set-buffer (find-file-noselect f)) + (rename-buffer "*preview*") + (display-buffer (get-buffer "*preview*")) + ;; stop iterating + '()) + ;; will stop iterating when l is nil + (setq l (cdr l))))) + ;; each extension tested and nothing found, let user know + (when (eq l '()) + (message "No image found.")))))) + +;;;; +;;;; View +;;;; +(defun graphviz-dot-view () + "Runs an external viewer. This creates an external process every time it +is executed. If `graphviz-dot-save-before-view' is set, the current +buffer is saved before the command is executed." + (interactive) + (let ((cmd (if graphviz-dot-view-edit-command + (if (string-match "XEmacs" emacs-version) + (read-shell-command "View command: " + (format graphviz-dot-view-command + (buffer-file-name))) + (read-from-minibuffer "View command: " + (format graphviz-dot-view-command + (buffer-file-name)))) + (format graphviz-dot-view-command (buffer-file-name))))) + (if graphviz-dot-save-before-view + (save-buffer)) + (setq novaproc (start-process-shell-command + (downcase mode-name) nil cmd)) + (message (format "Executing `%s'..." cmd)))) + +;;;; +;;;; Completion +;;;; +(defvar graphviz-dot-str nil) +(defvar graphviz-dot-all nil) +(defvar graphviz-dot-pred nil) +(defvar graphviz-dot-buffer-to-use nil) +(defvar graphviz-dot-flag nil) + +(defun graphviz-dot-get-state () + "Returns the syntax state of the current point." + (let ((state (parse-partial-sexp (point-min) (point)))) + (cond + ((nth 4 state) 'comment) + ((nth 3 state) 'string) + ((not (nth 1 state)) 'out) + (t (save-excursion + (skip-chars-backward "^[,=\\[]{};") + (backward-char) + (cond + ((looking-at "[\\[,]{};") 'attribute) + ((looking-at "=") (progn + (backward-word 1) + (if (looking-at "[a-zA-Z]*color") + 'color + 'value))) + (t 'other))))))) + +(defun graphviz-dot-get-keywords () + "Return possible completions for a word" + (let ((state (graphviz-dot-get-state))) + (cond + ((equal state 'comment) ()) + ((equal state 'string) ()) + ((equal state 'out) graphviz-attr-keywords) + ((equal state 'value) graphviz-value-keywords) + ((equal state 'color) graphviz-color-keywords) + ((equal state 'attribute) graphviz-attr-keywords) + (t graphviz-attr-keywords)))) + +(defvar graphviz-dot-last-word-numb 0) +(defvar graphviz-dot-last-word-shown nil) +(defvar graphviz-dot-last-completions nil) + +(defun graphviz-dot-complete-word () + "Complete word at current point." + (interactive) + (let* ((b (save-excursion (skip-chars-backward "a-zA-Z0-9_") (point))) + (e (save-excursion (skip-chars-forward "a-zA-Z0-9_") (point))) + (graphviz-dot-str (buffer-substring b e)) + (allcomp (if (and graphviz-dot-toggle-completions + (string= graphviz-dot-last-word-shown + graphviz-dot-str)) + graphviz-dot-last-completions + (all-completions graphviz-dot-str + (graphviz-dot-get-keywords)))) + (match (if graphviz-dot-toggle-completions + "" (try-completion + graphviz-dot-str (mapcar '(lambda (elm) + (cons elm 0)) allcomp))))) + ;; Delete old string + (delete-region b e) + + ;; Toggle-completions inserts whole labels + (if graphviz-dot-toggle-completions + (progn + ;; Update entry number in list + (setq graphviz-dot-last-completions allcomp + graphviz-dot-last-word-numb + (if (>= graphviz-dot-last-word-numb (1- (length allcomp))) + 0 + (1+ graphviz-dot-last-word-numb))) + (setq graphviz-dot-last-word-shown + (elt allcomp graphviz-dot-last-word-numb)) + ;; Display next match or same string if no match was found + (if (not (null allcomp)) + (insert "" graphviz-dot-last-word-shown) + (insert "" graphviz-dot-str) + (message "(No match)"))) + ;; The other form of completion does not necessarily do that. + + ;; Insert match if found, or the original string if no match + (if (or (null match) (equal match 't)) + (progn (insert "" graphviz-dot-str) + (message "(No match)")) + (insert "" match)) + ;; Give message about current status of completion + (cond ((equal match 't) + (if (not (null (cdr allcomp))) + (message "(Complete but not unique)") + (message "(Sole completion)"))) + ;; Display buffer if the current completion didn't help + ;; on completing the label. + ((and (not (null (cdr allcomp))) (= (length graphviz-dot-str) + (length match))) + (with-output-to-temp-buffer "*Completions*" + (display-completion-list allcomp)) + ;; Wait for a keypress. Then delete *Completion* window + (momentary-string-display "" (point)) + (if graphviz-dot-delete-completions + (delete-window + (get-buffer-window (get-buffer "*Completions*")))) + ))))) + +;;;###autoload +(add-to-list 'auto-mode-alist '("\\.dot\\'" . graphviz-dot-mode)) +(add-to-list 'auto-mode-alist '("\\.gv\\'" . graphviz-dot-mode)) + +;;; graphviz-dot-mode.el ends here + diff --git a/elisp/emacs-goodies-el/highlight-beyond-fill-column.el b/elisp/emacs-goodies-el/highlight-beyond-fill-column.el new file mode 100755 index 0000000..fcc01e9 --- /dev/null +++ b/elisp/emacs-goodies-el/highlight-beyond-fill-column.el @@ -0,0 +1,125 @@ +;;; highlight-beyond-fill-column.el --- font-lock-add-keywords aid for Emacs + +;; Copyright (C) 1985, 1986, 1987, 1992 Free Software Foundation, Inc. + +;; Author: Sandip Chitale (sandip.chitale@blazesoft.com) +;; Keywords: programming decipline convenience + +;; Keywords: +;; Time-stamp: Aug 23 2001 8:56 PM Pacific Daylight Time +;; Version: 1.1 + +;; This file is *NOT* (yet?) part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with 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 defines a function that can be used by `font-lock-add-keywords' to find the columns +;; that are beyond `fill-column'. +;; +;; Installation: +;; Put the following in your .emacs +;; +;; (require 'highlight-beyond-fill-column) +;; +;; Example usage: +;; +;; Customize the `highlight-beyond-fill-column-in-modes' variable to +;; setup the list of modes in which to highlight-beyond-fill-column +;; +;; Customize the `highlight-beyond-fill-column-face' variable to +;; to setup the face used for highlight-beyond-fill-column +;; +;; Acknowledgement: +;; +;; This is based on initial code provided by Jim Janney (jjanney@xmission.com) +;; + +;;; Code: +(defcustom highlight-beyond-fill-column-in-modes nil + "The list of modes in which to highlight-beyond-fill-column." + :group 'fill + :type '(repeat string) + ) + +(defcustom highlight-beyond-fill-column-face 'underline + "The face to use with highlight-beyond-fill-column." + :group 'fill + :type 'face + ) + +(defun find-after-fill-column (limit) + "A function that can be used by `font-lock-add-keywords' to find columns that are +beyond the `fill-column'." + (let ( + ; remember the point + (original-point (point)) + ) + ; if already past the fill column start on next line + (if (> (current-column) fill-column) + (forward-line 1) + ) + (while (and (< (point) limit) ; still within limit + (or (< (move-to-column fill-column) fill-column) ; the line has less than `fill-column' columns + (= (point) (line-end-position)) ; end of line + ) + ) + ; goto next line + (forward-line 1) + ) + + (if (>= (point) limit) ; beyond limit + (progn + (goto-char original-point) ; restore point + nil ; return nil + ) + (set-match-data (list (point-marker) ; set match data + (progn + (end-of-line) + (forward-char) ; this gives the highlight till the end of the window + (point-marker) + ) + ) + ) + t) ; return t indicating that the match data was set + ) + ) + +(defun init-highlight-beyond-fill-column () + "" + (let ( + (modelist highlight-beyond-fill-column-in-modes) + mode + ) + (while modelist + (setq mode (intern (car modelist))) + (if (and mode + (functionp mode)) + (font-lock-add-keywords mode + '( + (find-after-fill-column 0 highlight-beyond-fill-column-face prepend) + ) + ) + ) + (setq modelist (cdr modelist)) + ) + ) + ) + +(add-hook 'after-init-hook 'init-highlight-beyond-fill-column) + +(provide 'highlight-beyond-fill-column) diff --git a/elisp/emacs-goodies-el/highlight-completion.el b/elisp/emacs-goodies-el/highlight-completion.el new file mode 100755 index 0000000..b14358b --- /dev/null +++ b/elisp/emacs-goodies-el/highlight-completion.el @@ -0,0 +1,1614 @@ +;;; highlight-completion.el --- completion with highlighted provisional text +;; Copyright (c) 1991-1996 Mark Haiman, Nick Reingold, John Palmieri +;; Copyright (c) 1997-2001 John Palmieri +;; +;; Author: John Palmieri +;; URL: http://www.math.washington.edu/~palmieri/Emacs/hlc.html +;; Keywords: completion +;; Version: 0.08 of Fri Sep 30 12:59:03 PDT 2005 +;; +;; This file is not part of GNU Emacs. +;; +;; This package 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 package 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. +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; This package is based on the lightning completion package, +;; written by Mark Haiman and Nick Reingold, then modified by me. I +;; am the author of this package, so any problems are completely +;; my fault. All the good parts probably came from Mark and Nick's +;; original code... +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Description: +;; +;; This package modified how Emacs performs completions. Ordinarily, +;; if you are typing a file name into the minibuffer (after hitting +;; C-x C-f, say), if you type a few letters and hit the TAB key, then +;; Emacs completes as far as possible. For example, suppose the +;; directory contains only these files: +;; filbert filibuster frank grunge.tex +;; If you type 'g' followed by TAB, then 'runge.tex' is inserted. If +;; you hit 'fi' then TAB, an 'l' is inserted. If you hit 'f' then TAB, +;; there is no unique continuation of the file name, so Emacs opens up +;; a new window displaying the list of possible completions. +;; +;; That's the old system. This package provides a variant: if you +;; type 'g', then 'runge.tex' is automatically inserted as highlighted +;; text, to indicate that it's only provisional. The point remains +;; immediately after the 'g'. If you hit TAB, the point jumps to the +;; end, and the added text is no longer highlighted. (So if you +;; weren't looking at the screen, you wouldn't know that anything +;; different had happened.) If after hitting 'g', you typed 'a' +;; (because you wanted to find a new file 'gaptooth.el') the +;; highlighted text would disappear. The effects of various keys: +;; TAB: jump forward to the end of the highlighted text. If no +;; text is highlighted, open up a window showing possible +;; completions. +;; SPC: jump forward a word (so 'g' followed by SPC would yield +;; 'grunge.tex', with the point after the '.', and with 'tex' +;; highlighted). If no text is highlighted, open up a window +;; showing possible completions. +;; ?: open up a window showing possible completions. +;; RET: open the named file (so 'g' followed by RET would open +;; 'grunge.tex'). +;; C-g: delete the highlighted text and stop this modified +;; completion process (and exit the minibuffer, if you're in the +;; minibuffer). +;; C-c: delete the highlighted text and stop this modified +;; completion process. +;; character: if consistent with completion, unhighlight it and +;; move the point forward. if inconsistent, insert the +;; character and delete the highlighted text, stopping this +;; completion process. +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; How to use: +;; +;; 1. Put this file (i.e., "highlight-completion.el") in your load-path. +;; 2. Put +;; (require 'highlight-completion) +;; in your .emacs file (or your .xemacs/init.el file) +;; 3. Turn on highlight completion by either running +;; M-x highlight-completion-mode +;; or putting this in your .emacs file: +;; (highlight-completion-mode 1) +;; or customizing variables: +;; M-x customize-group highlight-completion +;; Then turn on "Highlight completion mode". +;; You may want to modify some of the entries in "Highlight completion list". +;; 4. You can also run the functions +;; hc-complete-file-name to complete file names +;; hc-complete-lisp-function lisp functions +;; hc-complete-lisp-variable lisp variables +;; hc-complete-kill-ring contents of kill ring +;; hc-complete-buffer-contents buffer contents +;; hc-complete-word words, using ispell +;; These functions can be used anywhere, not just in the +;; minibuffer. If the variable hc-ctrl-x-c-is-completion is +;; non-nil, then these functions are bound to keys, with prefix +;; `C-x c' (not to be confused with `C-x C-c', of course). See the +;; documentation of that customizable variable for more +;; information. +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; In case you want to write a function that uses highlight completion +;; in some other setting, you will want to base your function on the +;; all-purpose completion function +;; +;; hc-completing-insert +;; +;; See its documentation string for a description. The function +;; hc-ispell-complete-word provides a good example of how to use +;; this when there is an easily available list of possible +;; completions. The ispell package provides the function lookup-words +;; which does this. To use this with lightning completion, one only +;; has to write a function that acts as a wrapper for lookup-words and +;; is suitable for use as the TABLE argument in hc-completing-insert. +;; +;; Completion on buffer contents is another, more involved, example. +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Lightning completion, on which this is based, works with a package +;; called Ultra-TeX to provide dynamic completion of TeX commands. I +;; will work on adding highlight completion as an option for +;; Ultra-TeX mode. +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Version history +;; +;; 0.01 (30-May-2001) first version. +;; 0.02 (30-May-2001) tinkering. +;; 0.03 (31-May-2001) tinkering. +;; 0.04 (31-May-2001) use overlays instead of text-properties in GNU Emacs. +;; 0.05 (21-Jun-2001) add function hc-ispell-complete-word +;; 0.06 (21-Jun-2001) new customization procedure. see above. some +;; bug fixes, too. +;; 0.07 (22-Jun-2001) renamed `hc-completing-insert-BLAH' to `hc-complete-BLAH'. +;; also added a bit more documentation. +;; 0.08 (30-Sep-2005) bug fix for GNU Emacs version 22. +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defconst hc-version-string "0.07" + "Version of highlighting completion package.") + +(defconst hc-version hc-version-string + "Version of highlighting completion package.") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Customization +;; + +(defgroup highlight-completion nil + "Highlight completion mode: display completion as highlighted text." + :tag "Highlight completion" + :prefix "hc" + :link '(url-link :tag "Home Page" "http://www.math.washington.edu/~palmieri/Emacs/hlc.html") + :group 'abbrev) + +(defconst hc-xemacs-p + (string-match "XEmacs\\|Lucid" emacs-version) + "Non-nil if using XEmacs.") + +(defconst hc-emacs-20-p + (and (boundp 'emacs-major-version) + (= emacs-major-version 20)) + "Non-nil if using Emacs 20.") + +(defconst hc-emacs-21-p + (and (boundp 'emacs-major-version) + (not hc-xemacs-p) + (>= emacs-major-version 21)) + "Non-nil if using GNU Emacs 21 or later.") + +(defcustom highlight-completion-mode nil + "Toggle whether `highlighting' is on. +If on, you may want to customize highlight-completion-list to specify +contexts in which to use highlighting. If off, you can still +run functions like hc-complete-file-name or +hc-complete-a-la-mode to use this completion." + :type '(boolean) + :set (lambda (symbol value) + (highlight-completion-mode (if value 1 -1))) + :initialize 'custom-initialize-default + :require 'highlight-completion + :group 'highlight-completion) + +(defun highlight-completion-mode (&optional prefix) + "Activate highlight-completion. Deactivates with negative universal +argument." + (interactive "p") + (or prefix (setq prefix 0)) + (cond ((>= prefix 0) + (setq highlight-completion-mode t) + (add-hook 'minibuffer-setup-hook 'highlight-completion-setup)) + (t (setq highlight-completion-mode nil)))) + +(defconst highlight-completion-list-default + '((files . t) + (functions . t) + (commands . t) + (variables . t) + (user-variables . t) + (lisp-objects . t) + (info-menu-items . t) + (buffers . t) + (query . nil) + (misc . nil)) + "default value of highlight-completion-list") + +(defun hc-convert-completion-list (list) + "Convert LIST (which should be highlight-completion-list-external) +to a list of (symbol . boolean) pairs." + (let ((hc-list highlight-completion-list-default) + (temp list) + answer) + (if (< (length temp) (length hc-list)) + (setq temp (append temp (make-list + (- (length hc-list) (length temp)) + nil)))) + (while hc-list + (setq answer (cons (cons (caar hc-list) (car temp)) answer) + hc-list (cdr hc-list) + temp (cdr temp))) + (reverse answer))) + +(defun hc-unconvert-completion-list (list) + "Convert LIST (which should be highlight-completion-list) +to a list of boolean values." + (mapcar 'cdr list)) + +(defcustom highlight-completion-list-external + (hc-unconvert-completion-list highlight-completion-list-default) + "Enable highlighting completion in specific contexts. +If nil, turn off completion in that context. If t, turn on +completion. The contexts are reasonably self-explanatory: + `Files' means file name completion (e.g., after `C-x C-f'). + `Functions' means lisp function completion (e.g., after `C-h f'). + `Commands' means command completion (e.g., after `M-x'). + `Variables' means lisp variable completion (e.g., after `C-h v'). + `User variables' means completion on `user variables'--see the + documentation for the function `user-variable-p', for instance, + to see what this means. + `Lisp objects' means both funtions and variables. + `Info menu items' is what it says (e.g., after hitting `m' in info mode). + `Buffer names' is what it says (e.g., after hitting `C-x C-b'). + `Query replace' means: complete on contents of the current buffer + when asking for a string to replace when running query-replace (`M-%'). + `Miscellany' means: complete on whatever seems appropriate when + Emacs knows how to complete (e.g., in gnus, if you hit `j' to run + `gnus-jump-to-group', this will complete on group names)." + :tag "Highlight completion list" + :type '(list (boolean :tag "Files ") + (boolean :tag "Functions ") + (boolean :tag "Commands ") + (boolean :tag "Variables ") + (boolean :tag "User variables ") + (boolean :tag "Lisp objects ") + (boolean :tag "Info menu items") + (boolean :tag "Buffer names ") + (boolean :tag "Query replace ") + (boolean :tag "Miscellany ")) + :set (lambda (symbol value) + (setq highlight-completion-list + (hc-convert-completion-list value)) + (set symbol value)) + :group 'highlight-completion) + +(defvar highlight-completion-list + (hc-convert-completion-list highlight-completion-list-external) + "List of things on which to complete. +This is a list, each element of which looks like (SITUATION) +or (SITUATION . t). In the former case, highlighting completion is off +in SITUATION, and in the latter case, highlighting completion is on in +SITUATION. You can modify this list directly, but it is better +customize it.") + +(defcustom hc-ignored-file-extensions-external + completion-ignored-extensions + "File extensions to ignore when doing highlight completion" + :type '(repeat string) + :tag "Hc Ignored File Extensions" + :set (lambda (symbol value) + (setq hc-ignored-file-extensions + (concat "\\(" + (mapconcat 'regexp-quote value "\\|") + "\\)$")) + (set symbol value)) + :group 'highlight-completion) + +(defvar hc-ignored-file-extensions + (concat "\\(" + (mapconcat 'regexp-quote + hc-ignored-file-extensions-external + "\\|") + "\\)$") + "Regular expression of file extensions to ignore when doing +highlight completion.") + +(defcustom hc-word-connectors-external '("." "-" "/") + "Characters which will be added automatically when completing a word." + :type '(repeat string) + :tag "Hc Word Connectors" + :set (lambda (symbol value) + (setq hc-word-connectors + (concat "\\(" + (mapconcat 'regexp-quote value "\\|") + "\\)")) + (set symbol value)) + :group 'highlight-completion) + +(defvar hc-word-connectors + (concat "\\(" + (mapconcat 'regexp-quote + hc-word-connectors-external + "\\|") + "\\)$") + "Regular expression of characters to be added to the end when completing a word.") + +(defvar hc-completions-map (make-sparse-keymap) + "Key map for highlight completion functions.") + +(defcustom hc-ctrl-x-c-is-completion nil + "Toggle whether `C-x c' is the prefix key for the various highlight +completion commands. If on, + + C-x c b runs hc-complete-buffer-name + C-x c f runs hc-complete-lisp-function + C-x c F runs hc-complete-file-name + C-x c i runs hc-complete-word + C-x c k runs hc-complete-kill-ring + C-x c u runs hc-complete-a-la-mode + C-x c v runs hc-complete-lisp-variable + C-x c y runs hc-complete-buffer-contents + C-x c C-h lists all of the key bindings starting with C-x c + +These functions do completion on the appropriate thing in any buffer, +not just the minibuffer. This is useful for typing file names or lisp +functions or whatever. +If turned off, `C-x c' does nothing." + :type '(boolean) + :set (lambda (symbol value) + (if value + (define-key ctl-x-map "c" hc-completions-map) + (define-key ctl-x-map "c" nil)) + (set symbol value)) + :group 'highlight-completion) + +(define-key hc-completions-map "f" 'hc-complete-lisp-function) +(define-key hc-completions-map "v" 'hc-complete-lisp-variable) +(define-key hc-completions-map "o" 'hc-complete-lisp-object) +(define-key hc-completions-map "F" 'hc-complete-file-name) +(define-key hc-completions-map "u" 'hc-complete-a-la-mode) +(define-key hc-completions-map "b" 'hc-complete-buffer-name) +(define-key hc-completions-map "k" 'hc-complete-kill-ring) +(define-key hc-completions-map "y" 'hc-complete-buffer-contents) +(define-key hc-completions-map "i" 'hc-complete-word) + +(defcustom hc-ctrl-backslash-completes-a-la-mode nil + "Toggle whether `C-\\' runs the `hc-complete-a-la-mode'. +If turned on, `C-\\' runs this function, which turns on highlighting +completion. This is helpful in the minibuffer, for instance, if the +completion process has stopped and you want to start it up +again---just hit `C-\\'. +If turned off, `C-\\' does nothing." + :type '(boolean) + :set (lambda (symbol value) + (if value + (global-set-key "\C-\\" 'hc-complete-a-la-mode) + (global-set-key "\C-\\" nil)) + (set symbol value)) + :group 'highlight-completion) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Set up hc-mode, hc-mode-map, etc. +;; + +(defvar hc-mode nil + "Non-nil if using Highlight mode as a minor mode") +(make-variable-buffer-local 'hc-mode) +(or (assq 'hc-mode minor-mode-alist) + (setq minor-mode-alist (cons '(hc-mode " Highlight") + minor-mode-alist))) + +(defvar hc-mode-map nil + "Minor mode map for highlighting completion.") +(if hc-mode-map + nil + (let ((i 31) + (map (copy-keymap minibuffer-local-completion-map)) + (meta-map (make-keymap))) + (set-keymap-parent map nil) + (substitute-key-definition 'switch-to-completions + 'hc-switch-to-completions + map) + (substitute-key-definition 'switch-to-completions + 'hc-switch-to-completions + map + minibuffer-local-map) + (substitute-key-definition 'advertised-switch-to-completions + 'hc-advertised-switch-to-completions + map) + (substitute-key-definition 'advertised-switch-to-completions + 'hc-advertised-switch-to-completions + map + minibuffer-local-map) + (defalias 'hc-advertised-switch-to-completions + 'hc-switch-to-completions) + (substitute-key-definition 'exit-minibuffer + 'hc-exit-and-then + map) + (substitute-key-definition 'exit-minibuffer + 'hc-exit-and-then + map + minibuffer-local-map) + (substitute-key-definition 'keyboard-quit + 'hc-keyboard-quit + map) + (substitute-key-definition 'keyboard-quit + 'hc-keyboard-quit + map + minibuffer-local-map) + (substitute-key-definition 'abort-recursive-edit + 'hc-exit-and-then + map) + (substitute-key-definition 'abort-recursive-edit + 'hc-exit-and-then + map + minibuffer-local-map) + (substitute-key-definition 'minibuffer-keyboard-quit + 'hc-keyboard-quit + map) + (substitute-key-definition 'minibuffer-keyboard-quit + 'hc-keyboard-quit + map + minibuffer-local-map) + (substitute-key-definition 'next-history-element + 'hc-exit-and-then + map) + (substitute-key-definition 'next-history-element + 'hc-exit-and-then + map + minibuffer-local-map) + (substitute-key-definition 'previous-history-element + 'hc-exit-and-then + map) + (substitute-key-definition 'previous-history-element + 'hc-exit-and-then + map + minibuffer-local-map) + (substitute-key-definition 'minibuffer-complete + 'hc-try-to-complete + map) + (substitute-key-definition 'minibuffer-completion-help + 'hc-display-completions + map) + (if (keymapp (lookup-key map [menu-bar minibuf])) + (progn + (define-key map [menu-bar highlight] + (cons "Highlight" (make-sparse-keymap "Highlight"))) + (define-key map [menu-bar highlight tab] + '("List Completions" . hc-display-completions)) + (defalias 'hc-exit-and-then-alias 'hc-exit-and-then) + (define-key map [menu-bar highlight quit] + '("Quit" . hc-exit-and-then-alias)) + (define-key map [menu-bar highlight return] + '("Enter" . hc-exit-and-then-alias)) + (define-key map [menu-bar minibuf] 'undefined))) + (define-key map [escape] meta-map) + (while (<= (setq i (1+ i)) 126) + (or (lookup-key map (vector (list 'control i))) + (define-key map (vector (list 'control i)) + 'hc-exit-and-then)) + (or (lookup-key map (vector (list 'meta i))) + (progn + (define-key meta-map (char-to-string i) 'hc-exit-and-then) + (define-key map (vector (list 'meta i)) + 'hc-exit-and-then))) + (unless (string= (char-to-string i) "?") + (define-key map (char-to-string i) 'hc-self-insert-char))) + (define-key map [return] 'hc-exit-and-then) + (define-key map [linefeed] 'hc-exit-and-then) + (define-key map [(control j)] 'hc-exit-and-then) + (define-key map [(control g)] 'hc-keyboard-quit) + (define-key map [(control m)] 'hc-exit-and-then) + (define-key map (char-to-string 127) 'hc-exit-and-then) + (define-key map " " 'hc-keep-if-complete) + (define-key map [space] 'hc-keep-if-complete) + (define-key map [backspace] 'hc-delete) + (substitute-key-definition 'delete-backward-char + 'hc-delete + map) + (substitute-key-definition 'delete-backward-char + 'hc-delete + map + global-map) + (define-key map [tab] 'hc-try-to-complete) + (define-key map [(control c)] 'hc-quit) + (setq hc-mode-map map))) + +(defvar hc-completion-list-mode-map nil + "Local map for completion list buffers (for use with highlighting completion).") +(or hc-completion-list-mode-map + (let ((map (make-sparse-keymap))) + (define-key map [mouse-2] 'hc-mouse-choose-completion) + (define-key map [down-mouse-2] nil) + (define-key map "\C-m" 'hc-choose-completion) + (define-key map "\e\e\e" 'delete-completion-window) + (define-key map [left] 'previous-completion) + (define-key map [right] 'next-completion) + (setq hc-completion-list-mode-map map))) + +(and (boundp 'minor-mode-map-alist) + (or (assq 'hc-mode minor-mode-map-alist) + (setq minor-mode-map-alist + (cons (cons 'hc-mode hc-mode-map) + minor-mode-map-alist)))) +(make-variable-buffer-local 'hc-mode-map) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; miscellaneous variables +;; + +(defvar hc-stack nil) +(make-variable-buffer-local 'hc-stack) +(defvar hc-original-text nil) +(make-variable-buffer-local 'hc-original-text) +(defvar hc-highlighted-text nil) +(make-variable-buffer-local 'hc-highlighted-text) +(defvar hc-table nil) +(make-variable-buffer-local 'hc-table) +(defvar hc-predicate nil) +(make-variable-buffer-local 'hc-predicate) +(defvar hc-hook nil) +(make-variable-buffer-local 'hc-hook) +(defvar hc-prev-windows nil) ; state before completions window +(defvar hc-display-filter nil) +(make-variable-buffer-local 'hc-display-filter) +(defvar hc-last-display-time nil) ; "time" measured by stack top eq-ness + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; main functions +;; + +(defun hc-completing-insert (table pred init &optional hook message display) + "Highlight-complete string before point in the buffer, relative to +completion TABLE; allowing only completions that satisfy PRED. These +are used exactly as they are by `completing-read', which means this: + TABLE may be an alist, an obarray, or a function-symbol. For an +alist, PRED applies to the entries (conses). For an obarray, PRED +applies to the symbols. A function symbol will be called with a +STRING as first arg, PRED as second arg and third arg nil, t, or +`lambda'; according to third arg, the function is supposed to return +the common completion of STRING, all its completions, or the +truth-value of its completeness. In particular the function can be +like 'read-file-name-internal, with PRED the name of a directory. + Third arg INIT is the number of characters before point to complete +as the initial string. Barf immediately if this is no match. If +negative, we are resuming, so return nil unless situation at last quit +agrees with buffer before point; then restore that situation. + Optional arg HOOK is run on successful completion; gets same kind of +argument as PRED, or the complete string if TABLE is a function symbol. + On entering, message \"Completing ...\" is +displayed. + Optional arg DISPLAY is a function to call on each possible +completion before displaying. If the DISPLAY function returns nil, +that string is NOT displayed." + (condition-case nil + (if (not + (or + (and (>= init 0) ; starting fresh + (prog1 ; if so, reset things and be t + t + (setq hc-stack nil) + (let ((grab (buffer-substring-no-properties + (- (point) init) (point))) + (n 0)) + (if (eq table 'hc-read-file-name-internal) + (setq hc-original-text grab + grab (hc-expand-file-name grab) + init (length grab))) + (while (<= n init) + (setq hc-stack (cons (substring grab 0 n) hc-stack)) + (setq n (1+ n)))) ; completions=part grabs + (setq hc-table table + hc-predicate pred + hc-hook hook + hc-display-filter display))) + ;; see if resuming state is consistent: + (and + hc-stack + (and + (>= (point) + (+ (point-min) (length (car hc-stack)))) + (string= (car hc-stack) + (buffer-substring-no-properties + (- (point) (length (car hc-stack))) + (point)))) + (eq table hc-table) + (equal pred hc-predicate) + (equal hook hc-hook) + (equal display hc-display-filter)))) + nil ; trying to resume inconsistently + (setq hc-mode t) + (add-hook 'mouse-leave-buffer-hook + (function (lambda nil (hc-quit 'mouse)))) + (set-buffer-modified-p (buffer-modified-p)) ; update mode line + (setq hc-prev-windows (current-window-configuration)) + (if (or (> 0 init) + (string= (car hc-stack) "") ; don't try to complete "" + (let ((stat (hc-complete-stack-top ""))) + (or (stringp stat) (prog1 nil (hc-quit stat))))) + (progn + (while nil))) ; no-op + t) ; return t except for bad resume + (quit (setq unread-command-events + (list (hc-character-to-event ?\C-g)))))) + +;; bound to [(control c)], and also called by other functions +(defun hc-quit (arg &optional quick) + "Exit highlight completion mode. +ARG nil means because of error. ARG t means because successful. ARG +other means intentional quit without being complete. Interactively, +you get the last." + (interactive '(lambda)) + (remove-hook 'mouse-leave-buffer-hook + (function (lambda nil (hc-quit 'mouse)))) + (set-buffer-modified-p (buffer-modified-p)) ; update mode line + (add-hook 'minibuffer-setup-hook 'highlight-completion-setup) + (setq hc-mode nil) + (or arg (ding)) ; yell if an error + (or (eq arg 'mouse) + (and hc-prev-windows + (or (null hc-xemacs-p) + (null (minibuffer-window-active-p (minibuffer-window)))) + (progn + (set-window-configuration hc-prev-windows) + (setq hc-prev-windows nil)))) + (and (eq arg 'choose) + (looking-at (regexp-quote (car hc-stack))) + (forward-char (length (car hc-stack)))) + (if (or (eq arg t) (eq arg 'choose)) + (let ((name (car hc-stack))) + (setq hc-stack nil) ; no resume after success + (if hc-hook ; on success, call possible hook + (funcall hc-hook + (cond ((vectorp hc-table) ; table is an obarray + (intern-soft name hc-table)) + ((listp hc-table) ; table is an alist + (assoc name hc-table)) + (t name)))) ; table is a function + (if (> (current-column) fill-column) (run-hooks 'auto-fill-hook))) + ;; unsuccessful quit: + (setq hc-last-display-time nil)) + (unless (eq arg 'keep) + (delete-char (length hc-highlighted-text))) + (hc-unhighlight) + (setq hc-stack nil) + (setq hc-highlighted-text nil)) + +(defun hc-switch-stack-top (str &optional char) + "Replace top of stack with STR, fixing buffer. If optional arg CHAR +is 't, then modify highlighting etc as though a printable character +were hit: add just a single character to the stack and re-highlight. +If CHAR is a string, then add all of STR to the stack and highlight +CHAR--this is used by hc-complete-word." + (let ((inhibit-quit t)) + (hc-unhighlight) + (if hc-original-text + (delete-backward-char (length hc-original-text)) + (delete-backward-char (length (car hc-stack)))) + (setq hc-original-text nil) + (insert str) + (if hc-highlighted-text + (delete-char (length hc-highlighted-text))) + (if char + (progn + (if (stringp char) + (progn + (setq hc-highlighted-text char) + (save-excursion (insert hc-highlighted-text)) + (hc-highlight (point) (+ (point) (length + hc-highlighted-text))) + (setcar hc-stack str)) + (if (< (length (car hc-stack)) (length str)) + (progn + (forward-char + (- (length (car hc-stack)) + (length str))) + (if (< (point) (point-max)) + (progn + (setq hc-highlighted-text + (substring str (length (car hc-stack)))) + (hc-highlight (point) (+ (point) (length hc-highlighted-text)))) + (setq hc-highlighted-text nil)) + (setcar hc-stack (substring str 0 + (min + (length (car hc-stack)) + (length str))))) + (setq hc-highlighted-text nil) + (setcar hc-stack str)))) + (setq hc-highlighted-text nil) + (setcar hc-stack str)))) + +(defvar hc-highlight-face + (if hc-xemacs-p + 'zmacs-region + 'region)) + +(defvar hc-extent nil + "In XEmacs, extent for the highlighted text. In GNU Emacs, +overlay for the highlighted text.") + +(defun hc-highlight (start end) + "Highlight text from position START to END in the current buffer." + (if hc-xemacs-p + (progn + (setq hc-extent (make-extent start end (current-buffer))) + (set-extent-face hc-extent hc-highlight-face)) + (setq hc-extent (make-overlay start end)) + (overlay-put hc-extent 'face hc-highlight-face))) + +(defun hc-unhighlight nil + "Turn off highlighting, if it's on." + (if hc-xemacs-p + (progn + (if (extent-live-p hc-extent) + (delete-extent hc-extent))) + (if hc-extent + (delete-overlay hc-extent)))) + +(defun hc-pop-stack nil + "Pop the stack, fixing buffer." + (let ((inhibit-quit t) + (old-str (cadr hc-stack)) + (new-str (car hc-stack)) + str) + (setq str (hc-complete-stack-top nil t)) + (cond ((eq str t) + (setq str hc-highlighted-text) + (hc-switch-stack-top old-str) + (if (eq (hc-complete-stack-top nil t) t) + (hc-switch-stack-top + old-str + (concat (substring new-str (length old-str)) str)))) + ((stringp str) + (hc-switch-stack-top old-str) + (if (and (hc-complete-stack-top "") + (null (string= old-str (hc-complete-stack-top nil t)))) + (hc-switch-stack-top + old-str + (substring str (length old-str))))) + (t + (hc-switch-stack-top old-str))) + (setcdr hc-stack (cddr hc-stack)))) + +(defun hc-complete-stack-top (more &optional no-modify char) + "If possible, replace what's on top of stack, and before point, with +the common completion of that extended by MORE, returning that. Return +nil if no match. If result is complete and unique, return t. If +optional arg NO-MODIFY is non-nil, don't modify the stack--just see if +it would be complete. If optional arg CHAR is non-nil, this was +called after hitting a character (which may affect the placement of +the point when done)." + (let* ((str (concat (car hc-stack) more)) + ;; t:use real table. nil:truly no completions. alist:the completions + (all (or (symbolp hc-table) + (and (> (length str) 0) (= (aref str 0) ? )) + (mapcar 'list (all-completions str hc-table hc-predicate)))) + (try (and all (try-completion + str + (if (eq all t) hc-table all) + (if (eq all t) hc-predicate)))) + (str (if (eq try t) str try))) + (and try + (progn + (or no-modify + (hc-switch-stack-top str char)) + (or (eq try t) + (try-completion str + (if (eq all t) hc-table all) + (if (eq all t) hc-predicate))))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; functions bound to keys (see also hc-quit above) +;; + +;; bound to control characters +(defun hc-exit-and-then nil + "Intentional unsuccessful quit, then put back char to be read again." + (interactive) + (setq unread-command-events (list last-command-event)) + (hc-quit 'keep)) + +(defun hc-keyboard-quit nil + "Intentional unsuccessful quit, then put back char to be read again." + (interactive) + (setq unread-command-events (list last-command-event)) + (hc-quit 'quit)) + +;; bound to printing characters +(defun hc-self-insert-char nil + "Update hc-stack, insert this char, and run hc-complete." + (interactive) + (setq hc-stack (cons (concat + (car hc-stack) + (char-to-string last-command-char)) + hc-stack)) + (insert last-command-char) + (hc-complete)) + +(defun hc-complete nil + "Complete as far as possible. If no valid completions, quit. +If no valid completions and the customizable variable hc-clean-up is +non-nil, then delete characters until a valid string remains." + (interactive) + (let ((top (hc-complete-stack-top "" nil t))) + (cond ((eq top t) + (if (string= top (car hc-stack)) + (hc-quit t))) + ((null top) + (hc-unhighlight) + (delete-char (length hc-highlighted-text)) + (setq hc-highlighted-text nil) + (hc-quit 'quit))))) + +;; bound to [space] +(defun hc-keep-if-complete nil + "Quit with success if current stack top is complete. Otherwise +insert a space." + (interactive) + (if hc-highlighted-text + (hc-complete-word) + (let (top) + (if (setq top (hc-complete-stack-top " " nil t)) + (hc-switch-stack-top (concat (car hc-stack) " ") + (substring hc-highlighted-text 1)) + (setq top (hc-complete-stack-top "" nil t)) + (if (eq top t) + (hc-quit t) + (hc-try-to-complete)))))) + +(defun hc-complete-word nil + "Complete at most one word. After one word is completed, a space or +hyphen is added, provided that matches some possible completion." + (let ((old (car hc-stack)) + (top (hc-complete-stack-top "" t)) + (old-point (point)) + diff) + (if (string= old top) + (hc-try-to-complete) + (save-excursion + (goto-char old-point) + (forward-word 1) + (if (looking-at hc-word-connectors) + (forward-char 1)) + (setq diff (- (point) old-point))) + (if (and (eq top t) + (<= (+ (length (concat old hc-highlighted-text)) + (hc-minibuffer-prompt-width)) + (+ diff old-point))) + (progn + (if hc-highlighted-text + (forward-char (length hc-highlighted-text))) + (hc-quit 'keep)) + (setq top (concat old hc-highlighted-text)) + (if (< diff (length hc-highlighted-text)) + (hc-switch-stack-top (substring top 0 (+ (length old) diff)) + (substring top (+ (length old) diff))) + (hc-switch-stack-top top)))))) + +;; bound to [backspace] +(defun hc-delete nil + "Go back one completion unit. If there is no previous unit, quit quietly." + (interactive) + (if (null (cdr hc-stack)) (hc-quit 'keep) + (hc-pop-stack))) + +;; bound to [tab] +(defun hc-try-to-complete nil + "Try to complete. Complete as far as possible. +If there are choices, pop up buffer with list. If there are no valid +completions, ding." + (interactive) + (let ((old (car hc-stack)) + (top (hc-complete-stack-top "" t))) + (cond ((string= old top) + (hc-display-completions)) + ((eq top t) + (hc-complete-stack-top "" nil nil) + (hc-quit t)) + ((null top) + (ding)) + (t + (hc-switch-stack-top top) + (if (eq t (hc-complete-stack-top "" t)) + (progn + (hc-quit t) + (hc-complete-stack-top "" nil t)) + (hc-complete-stack-top "" nil t)))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; stuff for completions buffer. +;; + +(defvar hc-completion-buffer-name " *Completions*" + "Name of buffer in which to display list of completions") + +(defun hc-display-completions (&optional jump) + "Show possible completions, just like `minibuffer-completion-help'" + (interactive) + (if (and (not (equal jump 'jump)) + (equal hc-last-display-time (car hc-stack)) + (get-buffer-window hc-completion-buffer-name)) + (let ((ow (selected-window)) + (w (get-buffer-window hc-completion-buffer-name))) + (select-window w) + (condition-case nil + (if (<= (point-max) (window-end)) + (goto-char (point-min)) + (scroll-up)) + (error (goto-char (point-min)))) + (select-window ow)) + (setq hc-last-display-time (car hc-stack)) + (let ((all (all-completions (car hc-stack) hc-table hc-predicate)) + results ans) + (if (not (fboundp hc-display-filter)) nil + (while all + (setq ans (funcall hc-display-filter (car all))) + (and ans + (setq results (cons ans results))) + (setq all (cdr all))) + (setq all (nreverse results))) + (if all + (hc-display-completions-internal all))))) + +(defun hc-switch-to-completions () + "Select the completion list window." + (interactive) + ;; Make sure we have a completions window. + (hc-display-completions 'jump) + (select-window (get-buffer-window hc-completion-buffer-name)) + (goto-char (point-min)) + (search-forward "\n\n") + (forward-line 1)) + +(defun hc-choose-completion () + "Choose the completion that point is in or next to. +Just like choose-completion, except this calls +hc-choose-completion-string instead of choose-completion-string." + (interactive) + (let (beg end completion (buffer completion-reference-buffer) + (base-size completion-base-size)) + (if (and (not (eobp)) (get-text-property (point) 'mouse-face)) + (setq end (point) beg (1+ (point)))) + (if (and (not (bobp)) (get-text-property (1- (point)) 'mouse-face)) + (setq end (1- (point)) beg (point))) + (if (null beg) + (error "No completion here")) + (setq beg (previous-single-property-change beg 'mouse-face)) + (setq end (or (next-single-property-change end 'mouse-face) + (point-max))) + (setq completion (buffer-substring-no-properties beg end)) + (let ((owindow (selected-window))) + (if (and (one-window-p t 'selected-frame) + (window-dedicated-p (selected-window))) + ;; This is a special buffer's frame + (iconify-frame (selected-frame)) + (or (window-dedicated-p (selected-window)) + (bury-buffer))) + (select-window owindow)) + (hc-choose-completion-string completion buffer base-size))) + +(defun hc-mouse-choose-completion (event) + "Click on an alternative in the `*Completions*' buffer to choose it. +Just like mouse-choose-completion, except this calls +hc-choose-completion-string instead of choose-completion-string." + (interactive "e") + ;; Give temporary modes such as isearch a chance to turn off. + (run-hooks 'mouse-leave-buffer-hook) + (let ((buffer (window-buffer)) + choice + base-size) + (save-excursion + (set-buffer (window-buffer (posn-window (event-start event)))) + (if completion-reference-buffer + (setq buffer completion-reference-buffer)) + (setq base-size completion-base-size) + (save-excursion + (goto-char (posn-point (event-start event))) + (let (beg end) + (if (and (not (eobp)) (get-text-property (point) 'mouse-face)) + (setq end (point) beg (1+ (point)))) + (if (null beg) + (error "No completion here")) + (setq beg (previous-single-property-change beg 'mouse-face)) + (setq end (or (next-single-property-change end 'mouse-face) + (point-max))) + (setq choice (buffer-substring-no-properties beg end))))) + (let ((owindow (selected-window))) + (select-window (posn-window (event-start event))) + (if (and (one-window-p t 'selected-frame) + (window-dedicated-p (selected-window))) + ;; This is a special buffer's frame + (iconify-frame (selected-frame)) + (or (window-dedicated-p (selected-window)) + (bury-buffer))) + (select-window owindow)) + (hc-choose-completion-string choice buffer base-size))) + +(defun hc-choose-completion-string (choice &optional buffer base-size) + "Like choose-completion-string (from simple.el), with some stuff to +make it work well (it says here) with highlighting completion." + (let ((buffer (or buffer completion-reference-buffer))) + ;; If BUFFER is a minibuffer, barf unless it's the currently + ;; active minibuffer. + (if (and (string-match "\\` \\*Minibuf-[0-9]+\\*\\'" (buffer-name buffer)) + (or (not (active-minibuffer-window)) + (not (equal buffer + (window-buffer (active-minibuffer-window)))))) + (error "Minibuffer is not active for completion") + ;; Insert the completion into the buffer where completion was requested. + (set-buffer buffer) + (if base-size + (delete-region (+ base-size (point-min)) (point)) + (choose-completion-delete-max-match choice)) + (insert choice) +; (remove-text-properties (- (point) (length choice)) (point) +; '(mouse-face nil)) + (if (string-match (regexp-quote (car hc-stack)) choice) + (setq hc-stack (cons choice hc-stack)) + (setq hc-stack (cons (concat (car hc-stack) choice) + hc-stack))) + ;; choice may be part of a multiline string (e.g. in ultra-tex), + ;; so complete + (if (hc-complete-stack-top "" t) + (hc-complete-stack-top "")) + ;; Update point in the window that BUFFER is showing in. + (let ((window (get-buffer-window buffer t))) + (set-window-point window (point))) + ;; If completing for the minibuffer, exit it with this choice. + (if (and (equal buffer (window-buffer (minibuffer-window))) + minibuffer-completion-table) + ;; If this is reading a file name, and the file name chosen + ;; is a directory, don't exit the minibuffer. + (if (and (eq minibuffer-completion-table 'read-file-name-internal) + (file-directory-p (buffer-string))) + (select-window (active-minibuffer-window)) + (exit-minibuffer)) + (and hc-prev-windows + (hc-quit 'choose)))))) + +(defvar hc-completion-fixup-function nil + "A function to customize how completions are identified in completion lists. +`hc-completion-setup-function' calls this function with no arguments +each time it has found what it thinks is one completion. +Point is at the end of the completion in the completion list buffer. +If this function moves point, it can alter the end of that completion.") + +(defvar hc-completion-message-function + 'hc-completion-default-message-function + "A function to give the text at the top of the *Completions* +buffer. Called by `hc-completion-setup-function'.") + +(defun hc-completion-default-message-function nil + "Standard message function for hc-completion-setup-function." + (if (hc-window-system) + (insert (substitute-command-keys + "Click \\[hc-mouse-choose-completion] on a completion to select it.\n"))) + (insert (substitute-command-keys + "In this buffer, type \\[hc-choose-completion] to \ +select the completion near point.\n\n")) + (forward-line 1)) + +(defun hc-completion-setup-function () + "Like completion-setup-function (from simple.el), except with +slightly different messages." + (save-excursion + (let ((mainbuf (current-buffer))) + (set-buffer standard-output) + (completion-list-mode) + (make-local-variable 'completion-reference-buffer) + (setq completion-reference-buffer mainbuf) + ;; The value 0 is right in most cases, but not for file name completion. + ;; so this has to be turned off. + ;; (setq completion-base-size 0) + (goto-char (point-min)) + (if hc-completion-message-function + (funcall hc-completion-message-function)) + (while (re-search-forward "[^ \t\n]+\\( [^ \t\n]+\\)*" nil t) + (let ((beg (match-beginning 0)) + (end (point))) + (if hc-completion-fixup-function + (funcall hc-completion-fixup-function)) + (put-text-property beg (point) 'mouse-face 'highlight) + (goto-char end)))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; utilities +;; + +(defun word-grabber nil + "Move point to just after the word point is in or after, and +return length of word." + (skip-chars-forward "^ \n\t\f\"`'();{}") + (- (point) (save-excursion (skip-chars-backward "^ \n\t\f\"`'();{}") + (point)))) + +(defun point-adjust-hook (arg) + "Intended to be used when hc-table is an alist whose elements look +like `( . )'. Move point forward +chars, and then run (if non-nil)." + (forward-char (car (cdr arg))) + (if (cdr (cdr arg)) (funcall (cdr (cdr arg))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; entry points for completion on various things. see also +;; hc-complete-buffer-contents below. +;; + +(defun hc-complete-lisp-object nil + "Complete lisp object in buffer at point." + (interactive) + (hc-completing-insert obarray nil (word-grabber) nil "lisp objects")) + +(defun hc-complete-lisp-function nil + "Complete lisp object in buffer at point." + (interactive) + (hc-completing-insert obarray 'fboundp (word-grabber) nil "functions")) + +(defun hc-complete-lisp-variable nil + "Complete lisp object in buffer at point." + (interactive) + (hc-completing-insert obarray 'boundp (word-grabber) nil "variables")) + +(defun hc-complete-buffer-name nil + "Complete buffer name in buffer at point." + (interactive) + (hc-completing-insert (mapcar (function (lambda (x) (list (buffer-name x)))) + (buffer-list)) + nil (word-grabber) nil "buffer names")) + +(defun hc-complete-kill-ring nil + "Complete something from the kill ring in buffer at point." + (interactive) + (hc-completing-insert + (mapcar 'list + (apply 'append + (mapcar + (function + (lambda (x) + (cons x (and (string-match "\\s-+" x) + (list (substring x (match-end 0))))))) + kill-ring))) + nil 0 nil "recent kills")) + +(defun hc-complete-word nil + "Complete the current word using ispell." + (interactive) + (hc-completing-insert 'hc-lookup-words nil + (word-grabber) nil + "words")) + +(defun hc-lookup-words (string pred flag) + "Complete STRING a la ispell-complete-word. PRED will always be +nil--it's there for compatibility purposes. If FLAG is non-nil, return +all possible completions. If FLAG is nil, complete as far as +possible. If there is a unique completion, return it. If STRING +equals the unique completion, return t." + (require 'ispell) + (let ((word-list (lookup-words string)) + (guess string)) + (if flag word-list + (if (zerop (length word-list)) + nil + (if (= 1 (length word-list)) + (or (string= string (car word-list)) + (car word-list)) + (while (and (not (string= guess (car word-list))) + (not (member nil + (mapcar + (function + (lambda (word) + (string-match (regexp-quote + (substring + (car word-list) + 0 (1+ (length + guess)))) + word))) + word-list)))) + (setq guess (substring (car word-list) + 0 (1+ (length guess))))) + guess))))) + +(defalias 'hc-completing-insert-lisp-object 'hc-complete-lisp-object) +(defalias 'hc-completing-insert-lisp-function 'hc-complete-lisp-function) +(defalias 'hc-completing-insert-lisp-variable 'hc-complete-lisp-variable) +(defalias 'hc-completing-insert-buffer-name 'hc-complete-buffer-name) +(defalias 'hc-completing-insert-kill 'hc-complete-kill-ring) +(defalias 'hc-completing-insert-file-name 'hc-complete-file-name) +(defalias 'hc-completing-insert-buffer-contents 'hc-complete-buffer-contents) +(defalias 'hc-ispell-complete-word 'hc-complete-word) +(defalias 'hc-completing-insert-according-to-mode 'hc-complete-a-la-mode) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; completion a la mode +;; + +(defun hc-complete-a-la-mode nil + "Start highlighting completion. If possible, resumes stopped completion. +Otherwise, in the minibuffer, uses its table and predicate (slightly +modified for file name reading). Failing that, calls +`hc-default-completion-function' if the mode has it set. Final default +is lisp-object completion." + (interactive) + (cond ((hc-completing-insert hc-table hc-predicate -1 hc-hook) nil) + ((and (minibuffer-window-active-p (minibuffer-window)) + minibuffer-completion-table) + (let* ((table (if (eq minibuffer-completion-table + 'read-file-name-internal) + 'hc-read-file-name-internal + minibuffer-completion-table)) + (message + (cond ((eq table 'hc-read-file-name-internal) + "file names") + ((and (listp table) (bufferp (cdr (car table)))) + "buffers") + ((eq obarray table) + (cond ((not + (and (boundp + 'minibuffer-completion-predicate) + minibuffer-completion-predicate)) + "lisp objects") + ((eq 'fboundp minibuffer-completion-predicate) + "functions") + ((eq 'commandp minibuffer-completion-predicate) + "commands") + ((eq 'boundp minibuffer-completion-predicate) + "variables") + ((eq 'user-variable-p + minibuffer-completion-predicate) + "user variables"))) + (t "something"))) + (display (and (eq table 'hc-read-file-name-internal) + 'hc-file-display-filter))) + (or (hc-completing-insert table minibuffer-completion-predicate + -1) + (hc-completing-insert table minibuffer-completion-predicate + (progn (goto-char (point-max)) + (- (point) (point-min))) + nil message display)))) + ;; I moved this here to make existing minibuffer + ;; completion info take precedence over stopped completion. + ;; -- Nick Reingold 5/24/92 + ((hc-completing-insert hc-table hc-predicate -1 + hc-hook hc-display-filter) nil) + (hc-default-completion-function + (call-interactively hc-default-completion-function)) + (t (hc-complete-lisp-object)))) + +(defvar hc-default-completion-function nil + "Function to be called by M-x hc-complete-a-la-mode, +if non-nil") +(make-variable-buffer-local 'hc-default-completion-function) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; turning on highlighting +;; + +;; Customize the variable highlight-completion-mode, to turn on +;; highlighting completion. +(defun highlight-completion-setup () + (interactive) + (let ((pred minibuffer-completion-predicate) + complete-p message table display) + (cond ((eq minibuffer-history-variable 'file-name-history) + (setq complete-p (hc-complete-p 'files) + message "file names" + table 'hc-read-file-name-internal + pred (hc-expand-file-name pred) + display 'hc-file-display-filter)) + ((eq 'fboundp minibuffer-completion-predicate) + (setq complete-p (hc-complete-p 'functions) + message "functions" + table obarray)) + ((eq 'commandp minibuffer-completion-predicate) + (setq complete-p (hc-complete-p 'commands) + message "commands" + table obarray)) + ((eq 'boundp minibuffer-completion-predicate) + (setq complete-p (hc-complete-p 'variables) + message "variables" + table obarray)) + ((eq 'user-variable-p minibuffer-completion-predicate) + (setq complete-p (hc-complete-p 'user-variables) + message "user variables" + table obarray)) + ((and (eq minibuffer-completion-table obarray) + (not (and (boundp 'minibuffer-completion-predicate) + minibuffer-completion-predicate))) + (setq complete-p (hc-complete-p 'lisp-objects) + message "lisp objects" + table obarray)) + ((eq 'Info-complete-menu-item minibuffer-completion-table) + (setq complete-p (hc-complete-p 'info-menu-items) + message "Info menu items" + table minibuffer-completion-table)) + ((eq minibuffer-history-variable 'query-replace-history) + (setq complete-p (hc-complete-p 'query) + message "buffer contents" + table 'hc-buffer-completion-internal + pred (car (cdr (buffer-list))))) + ((and (listp minibuffer-completion-table) + (listp (car minibuffer-completion-table)) + (bufferp (cdr (car minibuffer-completion-table)))) + (setq complete-p (hc-complete-p 'buffers) + message "buffers" + table minibuffer-completion-table)) + (minibuffer-completion-table + (setq complete-p (hc-complete-p 'misc) + message "something" + table minibuffer-completion-table))) + (if (and highlight-completion-mode complete-p) + (progn + (or (hc-completing-insert table pred -1) + (hc-completing-insert table pred + (progn (goto-char (point-max)) + (- (point) + (point-min) + (hc-minibuffer-prompt-width))) + nil message display)))))) + +(defun query-replace-read-args (string regexp-flag) + (hc-query-replace-read-args string regexp-flag)) + +(defun hc-query-replace-read-args (string regexp-flag) + (let (from to) + (if query-replace-interactive + (setq from (car (if regexp-flag regexp-search-ring search-ring))) + (setq from (read-from-minibuffer (format "%s: " string) + nil nil nil + 'query-replace-history))) + (remove-hook 'minibuffer-setup-hook 'highlight-completion-setup) + (condition-case () + (setq to (read-from-minibuffer (format "%s %s with: " string from) + nil nil nil + 'query-replace-history)) + (quit + (add-hook 'minibuffer-setup-hook 'highlight-completion-setup) + (error "Quit"))) + (add-hook 'minibuffer-setup-hook 'highlight-completion-setup) + (list from to current-prefix-arg))) + +(defun hc-complete-p (arg) + "Non-nil if one should do highlighting completion in environment ARG, +as determined by the value of the variable highlight-completion-list." + (cdr (assoc arg highlight-completion-list))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; file completion stuff +;; + +(defun hc-complete-file-name (&optional dir init) + "Complete file name in buffer at point. Non-interactively, use directory +DIR (nil for current default-directory); start with INIT chars before point." + (interactive (list nil (word-grabber))) + (hc-completing-insert 'hc-read-file-name-internal + (or dir default-directory) (or init 0) + nil "file names" 'hc-file-display-filter)) + +(defconst hc-literal-file-regexp + "\\(\\(^\\|/\\)\\(~[^/]*\\|\\.\\.?\\)\\|\\${?[a-zA-Z0-9]*\\)$" + "Regexp for file names which don't get completed, yet.") +(defconst hc-expand-this-file-regexp + "\\(\\${[a-zA-Z0-9]*}\\|\\(^\\|/\\)\\.\\.?/\\)$" + "Regexp for file names which get expanded before completion.") + +(defun hc-read-file-name-internal (str dir action) + "\"Internal\" subroutine for `hc-complete-file-name'. Do not +call this." + (let (str-dir real-str) + (cond ((and (null action) (string-match hc-literal-file-regexp str)) + str) + ((progn (setq real-str (hc-expand-file-name + (substitute-in-file-name str) dir) + str-dir (file-name-directory real-str)) + (not (file-directory-p str-dir))) + nil) + ((eq action t) + (mapcar (function (lambda (x) + (expand-file-name x str-dir))) + (read-file-name-internal str dir action))) + ((file-directory-p real-str) + real-str) + (t + (let* ((exp (string-match hc-expand-this-file-regexp str)) + (str (if exp real-str str)) + (ans (read-file-name-internal str dir action))) + (if (null action) + (if (and exp (eq ans t)) str ans) + (and (not exp) ans))))))) + +(defun hc-expand-file-name (name &optional dir) + "Like expand-file-name, except that if first arg NAME is something +like `bozo/.' then return `bozo/'. expand-file-name, in contrast, +would return `bozo'." + (concat (expand-file-name name dir) + (if (or (and (< 1 (length name)) + (string= "/." (substring name -2))) + (and (< 2 (length name)) + (string= "/.." (substring name -3)))) + "/"))) + +(defun hc-file-display-filter (fn) + (cond ((string-match hc-ignored-file-extensions fn) + nil) + ((file-directory-p fn) + (let ((dir (if (file-directory-p (car hc-stack)) + (car hc-stack) + (directory-file-name (car hc-stack))))) + (if (string= fn (hc-expand-file-name "./" dir)) + "./" + (if (string= fn (hc-expand-file-name "../" dir)) + "../" + (concat (file-name-nondirectory (directory-file-name fn)) + "/"))))) + (t (file-name-nondirectory fn)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; buffer completion stuff. +;; +;; This section adapts highlighting completion to complete on +;; reasonably balanced substrings of a buffer. The main entry point +;; is +;; (hc-complete-buffer-contents BUF) +;; where BUF is interactively the current buffer or, with arg, a buffer +;; specified by the user. + +(defun hc-buffer-sub-hunk (start end) + "Return substring of current buffer from START at least up to END, extended +sufficiently to be balanced if possible, but in any case not to include +more than one non-blank line past END." + (save-excursion + (goto-char end) + (skip-chars-forward "\n") + (skip-chars-forward "^\n") + (save-restriction + (narrow-to-region start (point)) + (goto-char start) + (let (n) + (while (< (point) end) + (condition-case what (goto-char (setq n (scan-sexps (point) 1))) + (error (if (or (null n) (= ?U (aref (car (cdr what)) 0))) + (goto-char (point-max)) + (forward-char 1)))))) + (buffer-substring-no-properties start (point))))) + +(defvar hc-buf-comp-internal-last nil) ; last return of a try-type call + +(defun hc-buffer-completion-internal (str buf action) + "Internal subroutine for `hc-complete-buffer-contents'. Do +not call this. + Used like `read-file-name-internal' but for completing STR as a +substring of buffer BUF. Completing with space as last char matches +anything, as long as the match is unique. ACTION nil means common +part of proper extensions of STR, up to next sexp boundary, t means +list of some of these extensions. Other means return nil (no +substring is ever considered complete)." + (and + (memq action '(nil t)) ; never complete so keep is disabled + (save-window-excursion + (let* ((obuf (prog1 (current-buffer) (set-buffer buf))) + inhibit-quit case-fold-search find (l (length str))) + (prog2 + (if (eq buf obuf) ; hide completion in progress + (progn (setq inhibit-quit t) + (delete-backward-char (length (car hc-stack))))) + (if action + (let ((oball (make-vector 37 0)) (n 700)) + (save-excursion + (goto-char (point-min)) + (while (and (< 0 (setq n (1- n))) + (search-forward str nil t)) + (intern (hc-buffer-sub-hunk (match-beginning 0) + (min (point-max) (1+ (point)))) + oball)) + (if (< 0 n) (all-completions "" oball) + '("Completions too numerous to mention!")))) + (setq ; this arranges that identical repeats + hc-buf-comp-internal-last ; of a try call do no work, speeding + (if (eq str hc-buf-comp-internal-last) str ; up hc-complete-stack-top. + (save-excursion + (goto-char (point-min)) + (or + (and + (search-forward str nil t) + (setq find (hc-buffer-sub-hunk (match-beginning 0) (point))) + (progn + (while (and (> (length find) l) (search-forward str nil t)) + (setq find (try-completion + "" + (list (list find) + (list + (buffer-substring-no-properties + (match-beginning 0) + (min (point-max) + (+ (match-beginning 0) + (length find))))))))) + find)) + (and (string-match "\\s-" (substring str -1)) + (search-forward (setq str (substring str 0 -1)) nil t) + (setq find (hc-buffer-sub-hunk (match-beginning 0) + (min (point-max) + (1+ (point))))) + (progn + (setq l (1- l)) + (while (and (> (length find) l) + (search-forward str nil t)) + (setq find (try-completion + "" + (list + (list find) + (list + (buffer-substring-no-properties + (match-beginning 0) + (min (point-max) + (+ (match-beginning 0) + (length find))))))))) + (and (> (length find) l) find)))))))) + ;; unhide: + (if (eq buf obuf) (insert (car hc-stack)))))))) + +(defun hc-complete-buffer-contents (&optional buf) + "Complete on substrings of BUF extending to sexp boundaries. String is +never complete, so exit with C-c. Once unique, space means match more. +Interactively, with arg, ask for the buffer, else current buffer." + (interactive "P") + (if (and (interactive-p) buf) + (setq buf (read-buffer "Complete from buffer: "))) + (setq buf (or buf (current-buffer))) + (hc-completing-insert 'hc-buffer-completion-internal buf 0 nil "buffer contents")) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Functions that depend on the version of Emacs. +;; + +(defun hc-character-to-event (char) + "Convert a character CHAR into an event. This just returns CHAR +in GNU Emacs 19 or 20. In XEmacs, it calls character-to-event." + (if (fboundp 'character-to-event) + (character-to-event char) + char)) + +(defun hc-window-system () + "Non-nil if using x windows" + (if (fboundp 'console-type) + (eq (console-type) 'x) + (eq window-system 'x))) + +(defun hc-minibuffer-prompt-width () + "0 unless using GNU Emacs 21, in which case minibuffer-prompt-width" + (if hc-emacs-21-p + (minibuffer-prompt-width) + 0)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; More stuff dependent on the version of emacs. This is all related +;; to displaying completions. +;; + +(defvar hc-completion-default-help-string + '(concat + (if (device-on-window-system-p) + (substitute-command-keys + "Click \\\\[hc-mouse-choose-completion] on a completion to select it.\n") "") + (substitute-command-keys + "Type \\\\[hc-advertised-switch-to-completions] or \\\\[hc-advertised-switch-to-completions] to move to this buffer, for keyboard selection.\n +In this buffer, type \\\\[hc-choose-completion] to +select the completion near point.\n\n")) + "For use with XEmacs only. +Form the evaluate to get a help string for completion lists. +This string is inserted at the beginning of the buffer. +See `display-completion-list'.") + +(defun hc-display-completions-internal (all) + "Run display-completion-list with appropriate modifications, +depending on whether we're using XEmacs or not." + (if hc-xemacs-p + (with-output-to-temp-buffer hc-completion-buffer-name + (display-completion-list + (sort all 'string<) + :help-string hc-completion-default-help-string)) + (let ((old-hook completion-setup-hook) + (old-map completion-list-mode-map)) + (setq completion-setup-hook + 'hc-completion-setup-function + completion-list-mode-map + hc-completion-list-mode-map) + (with-output-to-temp-buffer hc-completion-buffer-name + (display-completion-list + (sort all 'string<))) + (setq completion-setup-hook old-hook + completion-list-mode-map old-map)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(provide 'highlight-completion) + +;;; highlight-completion.el ends here diff --git a/elisp/emacs-goodies-el/highlight-current-line.el b/elisp/emacs-goodies-el/highlight-current-line.el new file mode 100755 index 0000000..9d6e9dd --- /dev/null +++ b/elisp/emacs-goodies-el/highlight-current-line.el @@ -0,0 +1,405 @@ +;;; highlight-current-line.el --- highlight line where the cursor is. + +;; Copyright (c) 1997-2003 Christoph Conrad Time-stamp: <19.09.2003 20:10:05> + +;; Author: Christoph Conrad +;; Created: 10 Oct 1997 +;; Version: 0.57 +;; Keywords: faces + +;; This file is not yet part of any 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, 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: + +;; Minor mode to highlight the line the cursor is in. You can change colors +;; of foreground (text) and background. The default behaviour is to set +;; only a background color, so that font-lock fontification colors remain +;; visible (syntax coloring). Enable a buffer using the command +;; `highlight-current-line-minor-mode' and customize via: +;; +;; M-x customize-group highlight-current-line . +;; +;; You can select whether the whole line (from left to right window border) +;; is marked or only the really filled parts of the line (from left window +;; border to the last char in the line). The second behaviour is suitable +;; if it's important for you to see trailing spaces or tabs in a +;; line. Customize the variable `highlight-current-line-whole-line' (or use +;; the function `highlight-current-line-whole-line-on' retained for +;; compatibility with prior versions). +;; +;; You may enable the minor-mode automatically for (almost) all buffers by +;; customizing the variable `highlight-current-line-globally' (or using the +;; compatibility command `highlight-current-line-on'). Buffers whose +;; buffer-name match the regular expression in the customizable variable +;; `highlight-current-line-ignore-regexp' do not highlighted. You can +;; extend or redefine this regexp. This works together with the default +;; ignore function `highlight-current-line-ignore-function'. You can +;; redefine this function to implement your own criterias. + +;; (The functions `highlight-current-line-on', +;; `highlight-current-line-set-fg-color' and +;; `highlight-current-line-set-bg-color' are retained for backward +;; compatibility. There's a special color "none" defined to set no color.) + + +;;; People which made contributions or suggestions: + +;; This list is ordered by time. Latest in time first. +;; - Peter S Galbraith +;; - Masatake Yamato +;; - Hrvoje Niksic +;; - Jari Aalto +;; - Shawn Ostermann +;; - Peter Ikier +;; Many thanks to him for the idea. He liked this behaviour in another +;; editor ("Q"). + +;;; Installation: +;; +;; Put a copy of highlight-current-line.el/.elc into some path of +;; `load-path'. To show `load-path': load-path RET +;; +;; Load the file, e.g. add in ~/.emacs +;; +;; (require 'highlight-current-line) +;; +;; Enable it on a buffer using `M-x highlight-current-line-minor-mode' +;; or globally by customizing `highlight-current-line-globally'. +;; +;; Previous versions of this code worked by adding other comamnds in +;; ~/.emacs instead of using the custom interface. This is still +;; supported: +;; +;; ;; If you want to mark only to the end of line: +;; (highlight-current-line-whole-line-on nil) +;; ;; switch highlighting on +;; (highlight-current-line-on t) +;; ;; Ignore no buffer +;; (setq highlight-current-line-ignore-regexp nil) ; or set to "" +;; ;; alternate way to ignore no buffers +;; (fmakunbound 'highlight-current-line-ignore-function) +;; ;; Ignore more buffers +;; (setq highlight-current-line-ignore-regexp +;; (concat "Dilberts-Buffer\\|" +;; highlight-current-line-ignore-regexp)) + +;;; Troubleshooting: + +;; - Q: I do not see matching parens from paren.el any more! +;; - A: Check the colors from highlight-current-line or from show-paren-face +;; and choose some combination which works together. + +;;; ToDo: + +;; - highlight paragraphs, functions etc... (suggestion by Daniel Lundin +;; 19 Dec 1999) +;; - provide overlay priorities +;; (overlay-put highlight-current-line-overlay 'priority 60) +;; - better way to switch off 'ignore buffer' +;; - face fore/backgroundcolor depending on major-mode +;; - better way to detect xemacs + +;; - some suggestions for default keys +;; - highlight-current-line as minor mode. Suggested by Shawn Ostermann. + +;;; Change log: + +;; 10 Sept 2003 - v0.57 +;; - highlight-current-line-minor-mode created. +;; - highlight-current-line-globally defcustom added. + +;; 7 Sept 2003 - v0.56 +;; - defface for highlight-current-line-face with customization. +;; Thanks to Peter S. Galbraith for the suggestion. Retained +;; highlight-current-line-set-fg/bg-color for backward +;; compatibility. + +;; 7 Sept 2003 - v0.55 +;; - v0.54 change works now correctly + +;; 22 Mar 2003 - v0.54 +;; - don't highlight lines which contain faces specified in +;; highlight-current-line-high-faces. Elisp manual: "Currently, all +;; overlays take priority over text properties." So, if a text +;; property is a face, highlight-current-line always hides that face. + +;; 12 Mar 2002 - v0.53 +;; - updated email address + +;; 05 Feb 2001 +;; - highlight-current-line-ignore-regexp: better regexp for minibuffers + +;; 15 Jul 2000 - v0.52: +;; - Masatake YAMATO: added emacsclient / gnudoit support. Invoking emacs +;; to load a file from external, highlight-current-line couldn't +;; initially show the line of the loaded file highlighted. + +;; 19 Oct 1997 - v0.51: +;; - uses defcustom-library if available. Suggested by Jari Aalto and Hrvoje +;; Niksic. +;; - logic error in if-condition of post-command-hook. All Buffers were +;; ignored if highlight-current-line-ignore-function was unbound. + +;; 18 Oct 1997 - v0.5: +;; - GNU General Public License +;; - ignore user-definable buffernames which are ignored for +;; highlighting. Suggested by Jari Aalto. +;; - works with XEmacs, at least version 19.15. Mark whole line doesnt work +;; yet. Suggested by Jari Aalto. +;; - highlight-current-line-set-fg/bg-color understand "none" as color +;; - overlay-put moved from post-command-hook to initialization-code +;; - version-variable: `highlight-current-line-version'. Always +;; "major.minor". Suggested by Jari Aalto. + +;; 11 Oct 1997 - v0.4: +;; - Possibility to highlight whole line (from left to right windowborder) or +;; only from left window border to the last char in the line. +;; +;; 20 Aug 1997 - v0.3: +;; - First public released version. + +;;; Code: + +;; Initialization for XEmacs + +;; XEmacs needs overlay emulation package. +;; Old XEmacs won't have the package and we must quit. +(eval-and-compile + (if (boundp 'xemacs-logo) + (if (not (load "overlay" 'noerr)) + (error "\ +highlight-current-line.el: ** This package requires overlays. Abort")))) + +;; Compatibility code - blob for those without the custom library: +(eval-and-compile + (condition-case () + (require 'custom) + (error nil)) + (if (and (featurep 'custom) (fboundp 'custom-declare-variable)) + nil ;; We've got what we needed + ;; We have the old custom-library, hack around it! + (defmacro defgroup (&rest args) + nil) + (defmacro defcustom (var value doc &rest args) + (` (defvar (, var) (, value) (, doc)))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; Variables +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; can be set by user + +(defgroup highlight-current-line nil + "Highlight line where the cursor is." + :load 'highlight-current-line + :group 'faces) ;; or 'matching?? + +(defcustom highlight-current-line-ignore-regexp + (concat + "Faces\\|Colors\\| \\*Mini" + ;; for example: + ;; "\\|RMAIL.*summary\\|\\*Group\\|\\*Summary" + ) + "*Regexps for buffers to ignore. +Used by `highlight-current-line-ignore-function'." + :type 'regexp + :group 'highlight-current-line) + +(defcustom highlight-current-line-whole-line t + "*If non-nil, mark up to `end-of-line'. If nil, mark up to window-border. +Use `highlight-current-line-whole-line-on' to set this value." + :type 'boolean + :group 'highlight-current-line) + +(defcustom highlight-current-line-high-faces '() + "*Lines containing one of this faces are not highlighted." + :type 'list + :group 'highlight-current-line) + +(defface highlight-current-line-face + '((t (:background "wheat"))) + "Face used to highlight current line." + :group 'highlight-current-line) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; should not be set by user + +(defconst highlight-current-line-version "0.57" + "Version number." ) + +(defvar highlight-current-line-minor-mode nil + "Non-nil if using highlight-current-line mode as a minor mode. +Use the command `highlight-current-line-minor-mode' to toggle or set this +variable.") +(make-variable-buffer-local 'highlight-current-line-minor-mode) + +(defvar highlight-current-line-overlay + ;; Dummy initialization + (make-overlay 1 1) + "Overlay for highlighting.") + +;; Set face-property of overlay +(overlay-put highlight-current-line-overlay + 'face 'highlight-current-line-face) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; Functions +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; Internal function for test +(defun highlight-current-line-reload () + "Reload library highlight-current-line for test purposes." + (unload-feature 'highlight-current-line) + (load-library "highlight-current-line")) + +;; Decide whether to highlight the buffer. +(defun highlight-current-line-ignore-function () + "Check current buffer name against `highlight-current-line-ignore-regexp'. +Inhibits global enabling of highlight-current-line on buffer whose name +match this regexp." + (if (or (equal "" highlight-current-line-ignore-regexp) + (not highlight-current-line-ignore-regexp)) + nil + (string-match highlight-current-line-ignore-regexp (buffer-name)))) + +(defvar highlight-current-line-globally) + +;; Post-Command-Hook for highlighting +(defun highlight-current-line-hook () + "Post-Command-Hook for highlighting." + (condition-case () + (if (or highlight-current-line-minor-mode + (and highlight-current-line-globally + (or (not (fboundp 'highlight-current-line-ignore-function)) + (not (highlight-current-line-ignore-function))))) + (let ((current-point (point))) + + ;; Set overlay + (let ((beg (progn (beginning-of-line) (point))) + (end (progn (if highlight-current-line-whole-line + (forward-line 1) + (end-of-line)) + (point)))) + (if (delete nil (mapcar + (lambda( face ) + (text-property-any beg end 'face face)) + highlight-current-line-high-faces)) + (delete-overlay highlight-current-line-overlay) + (move-overlay highlight-current-line-overlay + beg end (current-buffer))) + + (goto-char current-point)))) + (error nil))) + +(defconst highlight-current-line-no-color (if (boundp 'xemacs-logo) + '[] + nil) + "'color' value that represents \"no color\".") + +;; Compatibility code +(defun highlight-current-line-on (&optional on-off) + "Switch highlighting of cursor-line on/off globally. +Key: \\[highlight-current-line-on]" + (interactive (list (y-or-n-p "Highlight line with cursor? "))) + (setq-default highlight-current-line-globally on-off) + (highlight-current-line on-off nil)) + +;; Compatibility code - Set foregroundcolor of cursor-line. +(defun highlight-current-line-set-fg-color (color) + "Set foregroundcolor for highlighting cursor-line to COLOR. +Key: \\[highlight-current-line-set-fg-color]" + (interactive "sForeground color (\"none\" means no color): ") + (if (equal "none" color) + (setq color highlight-current-line-no-color)) + (set-face-foreground 'highlight-current-line-face color)) + +;; Compatibility code - Set backgroundcolor of cursor-line. +(defun highlight-current-line-set-bg-color (color) + "Set backgroundcolor for highlighting cursor-line to COLOR. +Key: \\[highlight-current-line-set-bg-color]" + (interactive "sBackground color (\"none\" means no color): ") + (if (equal "none" color) + (setq color highlight-current-line-no-color)) + (set-face-background 'highlight-current-line-face color)) + +;; Compatibility code - Enable/Disable whole line marking +(defun highlight-current-line-whole-line-on (&optional on-off) + "Switch highlighting of whole line ON-OFF. +Key: \\[highlight-current-line-whole-line-on]" + (interactive (list (y-or-n-p "Highlight whole line? "))) + (setq highlight-current-line-whole-line on-off)) + +;; Enable/Disable Highlighting +(defun highlight-current-line (&optional on-off local) + "Switch highlighting of cursor-line ON-OFF +If LOCAL is non-nil, do so locally for the current buffer only." + (cond + (on-off + (if (or (= emacs-major-version 20) + (string-match "XEmacs" emacs-version)) + (make-local-hook 'post-command-hook)) + (add-hook 'post-command-hook 'highlight-current-line-hook nil local) + (if (boundp 'server-switch-hook) + (add-hook 'server-switch-hook 'highlight-current-line-hook nil local)) + (if (boundp 'gnuserv-visit-hook) + (add-hook 'gnuserv-visit-hook 'highlight-current-line-hook nil local))) + (t + (if (boundp 'server-switch-hook) + (remove-hook 'server-switch-hook 'highlight-current-line-hook local)) + (if (boundp 'gnuserv-visit-hook) + (remove-hook 'gnuserv-visit-hook 'highlight-current-line-hook local)) + (remove-hook 'post-command-hook 'highlight-current-line-hook t) + (delete-overlay highlight-current-line-overlay)))) + +;;;###autoload +(defun highlight-current-line-minor-mode (&optional arg) + "Toggle highlight-current-line minor mode. +With ARG, turn minor mode on if ARG is positive, off otherwise. +You can customize the face of the highlighted line and whether the entire +line is hightlighted by customizing the group highlight-current-line." + (interactive "P") + (setq highlight-current-line-minor-mode + (if (null arg) + (not highlight-current-line-minor-mode) + (> (prefix-numeric-value arg) 0))) + (if highlight-current-line-minor-mode + (highlight-current-line t t) + (highlight-current-line nil t))) + +(or (assq 'highlight-current-line-minor-mode minor-mode-alist) + (setq minor-mode-alist + (append minor-mode-alist + (list '(highlight-current-line-minor-mode " hcl"))))) + +(defcustom highlight-current-line-globally nil + "*Whether to enable `highlight-current-line-minor-mode' automatically. +This affects only files visited after this variable is set. +Buffers will not be enabled if they match the regular expression in +`highlight-current-line-ignore-regexp'." + :type 'boolean + :require 'highlight-current-line + :set (lambda (symbol value) + (set-default symbol value) + (if value + (highlight-current-line t nil) + (highlight-current-line nil nil))) + :group 'highlight-current-line) + +(provide 'highlight-current-line) + +;;; highlight-current-line.el ends here diff --git a/elisp/emacs-goodies-el/home-end.el b/elisp/emacs-goodies-el/home-end.el new file mode 100755 index 0000000..7f499dd --- /dev/null +++ b/elisp/emacs-goodies-el/home-end.el @@ -0,0 +1,98 @@ +;;; home-end.el --- Alternative Home and End commands. +;; Copyright 1996 Kai Grossjohann and Toby Speight +;; Copyright 2002-2011 Toby Speight + +;; home-end.el is free software distributed under the terms of the GNU +;; General Public Licence, version 3. + + +;;; Commentary: +;; +;; Some useful bindings for Home and End keys: +;; Hit the key once to go to the beginning/end of a line, +;; hit it twice in a row to go to the beginning/end of the window, +;; three times in a row goes to the beiginning/end of the buffer. +;; N.B. there is no timeout involved. +;; +;; To use: +;; (global-set-key [end] 'home-end-end) +;; (global-set-key [home] 'home-end-home) + + +;;; History: +;; +;; Kai Grossjohann +;; 29 Jul 96: +;; Posted to Usenet. +;; +;; Modified by Toby Speight +;; 1996-11-14: +;; Ensure that mark is set only when moving to beginning of window, +;; and is not set again when moving to beginning of buffer. +;; +;; Modified by Toby Speight > +;; 2002-07-12: +;; Added comments and license terms (with Kai's agreement). +;; Added autoload cookies. +;; +;; 2002-07-15: +;; Use `equal' instead of `eq' at suggestion of James LewisMoss +;; , for XEmacs compatibility. +;; +;; 2011-02-22: +;; Don't attempt to use `recent-keys' during keyboard macro definition +;; or replay. Thanks to Dima Kogan for the +;; patch. + +(defvar home-end-marker) + +;;;###autoload +(defun home-end-home (&optional arg) + "Go to beginning of line/window/buffer. +First hitting key goes to beginning of line, second in a row goes to +beginning of window, third in a row goes to beginning of buffer." + (interactive "P") + (if (or executing-kbd-macro + defining-kbd-macro) + (move-beginning-of-line arg) + (if arg + (beginning-of-buffer arg) + (let* ((keys (recent-keys)) + (len (length keys)) + (key1 (if (> len 0) (elt keys (- len 1)) nil)) + (key2 (if (> len 1) (elt keys (- len 2)) nil)) + (key3 (if (> len 2) (elt keys (- len 3)) nil)) + (key-equal-1 (equal key1 key2)) + (key-equal-2 (and key-equal-1 (equal key2 key3)))) + (cond (key-equal-2 (goto-char (point-min))) + (key-equal-1 (push-mark home-end-marker) + (move-to-window-line 0)) + (t (setq home-end-marker (copy-marker (point))) + (beginning-of-line))))))) + +;;;###autoload +(defun home-end-end (&optional arg) + "Go to end of line/window/buffer. +First hitting key goes to end of line, second in a row goes to end +of window, third in a row goes to end of buffer." + (interactive "P") + (if (or executing-kbd-macro + defining-kbd-macro) + (move-end-of-line arg) + (if arg + (beginning-of-buffer arg) + (let* ((keys (recent-keys)) + (len (length keys)) + (key1 (if (> len 0) (elt keys (- len 1)) nil)) + (key2 (if (> len 1) (elt keys (- len 2)) nil)) + (key3 (if (> len 2) (elt keys (- len 3)) nil)) + (key-equal-1 (equal key1 key2)) + (key-equal-2 (and key-equal-1 (equal key2 key3)))) + (cond (key-equal-2 (goto-char (point-max))) + (key-equal-1 (push-mark home-end-marker) + (move-to-window-line -1) + (end-of-line)) + (t (setq home-end-marker (copy-marker (point))) + (end-of-line))))))) + +(provide 'home-end) diff --git a/elisp/emacs-goodies-el/htmlize.el b/elisp/emacs-goodies-el/htmlize.el new file mode 100755 index 0000000..89a57b4 --- /dev/null +++ b/elisp/emacs-goodies-el/htmlize.el @@ -0,0 +1,1769 @@ +;; htmlize.el -- Convert buffer text and decorations to HTML. + +;; Copyright (C) 1997,1998,1999,2000,2001,2002,2003,2005,2006,2009 Hrvoje Niksic + +;; Author: Hrvoje Niksic +;; Keywords: hypermedia, extensions + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; This package converts the buffer text and the associated +;; decorations to HTML. Mail to to discuss +;; features and additions. All suggestions are more than welcome. + +;; To use this, just switch to the buffer you want HTML-ized and type +;; `M-x htmlize-buffer'. You will be switched to a new buffer that +;; contains the resulting HTML code. You can edit and inspect this +;; buffer, or you can just save it with C-x C-w. `M-x htmlize-file' +;; will find a file, fontify it, and save the HTML version in +;; FILE.html, without any additional intervention. `M-x +;; htmlize-many-files' allows you to htmlize any number of files in +;; the same manner. `M-x htmlize-many-files-dired' does the same for +;; files marked in a dired buffer. + +;; htmlize supports three types of HTML output, selected by setting +;; `htmlize-output-type': `css', `inline-css', and `font'. In `css' +;; mode, htmlize uses cascading style sheets to specify colors; it +;; generates classes that correspond to Emacs faces and uses ... to color parts of text. In this mode, the +;; produced HTML is valid under the 4.01 strict DTD, as confirmed by +;; the W3C validator. `inline-css' is like `css', except the CSS is +;; put directly in the STYLE attribute of the SPAN element, making it +;; possible to paste the generated HTML to other documents. In `font' +;; mode, htmlize uses ... to colorize HTML, +;; which is not standard-compliant, but works better in older +;; browsers. `css' mode is the default. + +;; You can also use htmlize from your Emacs Lisp code. When called +;; non-interactively, `htmlize-buffer' and `htmlize-region' will +;; return the resulting HTML buffer, but will not change current +;; buffer or move the point. + +;; I tried to make the package elisp-compatible with multiple Emacsen, +;; specifically aiming for XEmacs 19.14+ and GNU Emacs 19.34+. Please +;; let me know if it doesn't work on some of those, and I'll try to +;; fix it. I relied heavily on the presence of CL extensions, +;; especially for cross-emacs compatibility; please don't try to +;; remove that particular dependency. When byte-compiling under GNU +;; Emacs, you're likely to get some warnings; just ignore them. + +;; The latest version should be available at: +;; +;; +;; +;; You can find a sample of htmlize's output (possibly generated with +;; an older version) at: +;; +;; + +;; Thanks go to the multitudes of people who have sent reports and +;; contributed comments, suggestions, and fixes. They include Ron +;; Gut, Bob Weiner, Toni Drabik, Peter Breton, Thomas Vogels, Juri +;; Linkov, Maciek Pasternacki, and many others. + +;; User quotes: "You sir, are a sick, sick, _sick_ person. :)" +;; -- Bill Perry, author of Emacs/W3 + + +;;; Code: + +(require 'cl) +(eval-when-compile + (if (string-match "XEmacs" emacs-version) + (byte-compiler-options + (warnings (- unresolved)))) + (defvar font-lock-auto-fontify) + (defvar font-lock-support-mode) + (defvar global-font-lock-mode) + (when (and (eq emacs-major-version 19) + (not (string-match "XEmacs" emacs-version))) + ;; Older versions of GNU Emacs fail to autoload cl-extra even when + ;; `cl' is loaded. + (load "cl-extra"))) + +(defconst htmlize-version "1.36") + +;; Incantations to make custom stuff work without customize, e.g. on +;; XEmacs 19.14 or GNU Emacs 19.34. +(eval-and-compile + (condition-case () + (require 'custom) + (error nil)) + (if (and (featurep 'custom) (fboundp 'custom-declare-variable)) + nil ; we've got what we needed + ;; No custom or obsolete custom, define surrogates. Define all + ;; three macros, so we don't hose another library that expects + ;; e.g. `defface' to work after (fboundp 'defcustom) succeeds. + (defmacro defgroup (&rest ignored) nil) + (defmacro defcustom (var value doc &rest ignored) + `(defvar ,var ,value ,doc)) + (defmacro defface (face value doc &rest stuff) + `(make-face ,face)))) + +(defgroup htmlize nil + "Convert buffer text and faces to HTML." + :group 'hypermedia) + +(defcustom htmlize-head-tags "" + "*Additional tags to insert within HEAD of the generated document." + :type 'string + :group 'htmlize) + +(defcustom htmlize-output-type 'css + "*Output type of generated HTML, one of `css', `inline-css', or `font'. +When set to `css' (the default), htmlize will generate a style sheet +with description of faces, and use it in the HTML document, specifying +the faces in the actual text with . + +When set to `inline-css', the style will be generated as above, but +placed directly in the STYLE attribute of the span ELEMENT: . This makes it easier to paste the resulting HTML to +other documents. + +When set to `font', the properties will be set using layout tags +, , , , and . + +`css' output is normally preferred, but `font' is still useful for +supporting old, pre-CSS browsers, and both `inline-css' and `font' for +easier embedding of colorized text in foreign HTML documents (no style +sheet to carry around)." + :type '(choice (const css) (const inline-css) (const font)) + :group 'htmlize) + +(defcustom htmlize-generate-hyperlinks t + "*Non-nil means generate the hyperlinks for URLs and mail addresses. +This is on by default; set it to nil if you don't want htmlize to +insert hyperlinks in the resulting HTML. (In which case you can still +do your own hyperlinkification from htmlize-after-hook.)" + :type 'boolean + :group 'htmlize) + +(defcustom htmlize-hyperlink-style " + a { + color: inherit; + background-color: inherit; + font: inherit; + text-decoration: inherit; + } + a:hover { + text-decoration: underline; + } +" + "*The CSS style used for hyperlinks when in CSS mode." + :type 'string + :group 'htmlize) + +(defcustom htmlize-replace-form-feeds t + "*Non-nil means replace form feeds in source code with HTML separators. +Form feeds are the ^L characters at line beginnings that are sometimes +used to separate sections of source code. If this variable is set to +`t', form feed characters are replaced with the
separator. If this +is a string, it specifies the replacement to use. Note that 
 is
+temporarily closed before the separator is inserted, so the default
+replacement is effectively \"
\".  If you specify
+another replacement, don't forget to close and reopen the 
 if you
+want the output to remain valid HTML.
+
+If you need more elaborate processing, set this to nil and use
+htmlize-after-hook."
+  :type 'boolean
+  :group 'htmlize)
+
+(defcustom htmlize-html-charset nil
+  "*The charset declared by the resulting HTML documents.
+When non-nil, causes htmlize to insert the following in the HEAD section
+of the generated HTML:
+
+  
+
+where CHARSET is the value you've set for htmlize-html-charset.  Valid
+charsets are defined by MIME and include strings like \"iso-8859-1\",
+\"iso-8859-15\", \"utf-8\", etc.
+
+If you are using non-Latin-1 charsets, you might need to set this for
+your documents to render correctly.  Also, the W3C validator requires
+submitted HTML documents to declare a charset.  So if you care about
+validation, you can use this to prevent the validator from bitching.
+
+Needless to say, if you set this, you should actually make sure that
+the buffer is in the encoding you're claiming it is in.  (Under Mule
+that is done by ensuring the correct \"file coding system\" for the
+buffer.)  If you don't understand what that means, this option is
+probably not for you."
+  :type '(choice (const :tag "Unset" nil)
+		 string)
+  :group 'htmlize)
+
+(defcustom htmlize-convert-nonascii-to-entities (featurep 'mule)
+  "*Whether non-ASCII characters should be converted to HTML entities.
+
+When this is non-nil, characters with codes in the 128-255 range will be
+considered Latin 1 and rewritten as \"&#CODE;\".  Characters with codes
+above 255 will be converted to \"&#UCS;\", where UCS denotes the Unicode
+code point of the character.  If the code point cannot be determined,
+the character will be copied unchanged, as would be the case if the
+option were nil.
+
+When the option is nil, the non-ASCII characters are copied to HTML
+without modification.  In that case, the web server and/or the browser
+must be set to understand the encoding that was used when saving the
+buffer.  (You might also want to specify it by setting
+`htmlize-html-charset'.)
+
+Note that in an HTML entity \"&#CODE;\", CODE is always a UCS code point,
+which has nothing to do with the charset the page is in.  For example,
+\"©\" *always* refers to the copyright symbol, regardless of charset
+specified by the META tag or the charset sent by the HTTP server.  In
+other words, \"©\" is exactly equivalent to \"©\".
+
+By default, entity conversion is turned on for Mule-enabled Emacsen and
+turned off otherwise.  This is because Mule knows the charset of
+non-ASCII characters in the buffer.  A non-Mule Emacs cannot tell
+whether a character with code 0xA9 represents Latin 1 copyright symbol,
+Latin 2 \"S with caron\", or something else altogether.  Setting this to
+t without Mule means asserting that 128-255 characters always mean Latin
+1.
+
+For most people htmlize will work fine with this option left at the
+default setting; don't change it unless you know what you're doing."
+  :type 'sexp
+  :group 'htmlize)
+
+(defcustom htmlize-ignore-face-size 'absolute
+  "*Whether face size should be ignored when generating HTML.
+If this is nil, face sizes are used.  If set to t, sizes are ignored
+If set to `absolute', only absolute size specifications are ignored.
+Please note that font sizes only work with CSS-based output types."
+  :type '(choice (const :tag "Don't ignore" nil)
+		 (const :tag "Ignore all" t)
+		 (const :tag "Ignore absolute" absolute))
+  :group 'htmlize)
+
+(defcustom htmlize-css-name-prefix ""
+  "*The prefix used for CSS names.
+The CSS names that htmlize generates from face names are often too
+generic for CSS files; for example, `font-lock-type-face' is transformed
+to `type'.  Use this variable to add a prefix to the generated names.
+The string \"htmlize-\" is an example of a reasonable prefix."
+  :type 'string
+  :group 'htmlize)
+
+(defcustom htmlize-use-rgb-txt t
+  "*Whether `rgb.txt' should be used to convert color names to RGB.
+
+This conversion means determining, for instance, that the color
+\"IndianRed\" corresponds to the (205, 92, 92) RGB triple.  `rgb.txt'
+is the X color database that maps hundreds of color names to such RGB
+triples.  When this variable is non-nil, `htmlize' uses `rgb.txt' to
+look up color names.
+
+If this variable is nil, htmlize queries Emacs for RGB components of
+colors using `color-instance-rgb-components' and `x-color-values'.
+This can yield incorrect results on non-true-color displays.
+
+If the `rgb.txt' file is not found (which will be the case if you're
+running Emacs on non-X11 systems), this option is ignored."
+  :type 'boolean
+  :group 'htmlize)
+
+(defcustom htmlize-html-major-mode nil
+  "The mode the newly created HTML buffer will be put in.
+Set this to nil if you prefer the default (fundamental) mode."
+  :type '(radio (const :tag "No mode (fundamental)" nil)
+		 (function-item html-mode)
+		 (function :tag "User-defined major mode"))
+  :group 'htmlize)
+
+(defvar htmlize-before-hook nil
+  "Hook run before htmlizing a buffer.
+The hook functions are run in the source buffer (not the resulting HTML
+buffer).")
+
+(defvar htmlize-after-hook nil
+  "Hook run after htmlizing a buffer.
+Unlike `htmlize-before-hook', these functions are run in the generated
+HTML buffer.  You may use them to modify the outlook of the final HTML
+output.")
+
+(defvar htmlize-file-hook nil
+  "Hook run by `htmlize-file' after htmlizing a file, but before saving it.")
+
+(defvar htmlize-buffer-places)
+
+;;; Some cross-Emacs compatibility.
+
+;; I try to conditionalize on features rather than Emacs version, but
+;; in some cases checking against the version *is* necessary.
+(defconst htmlize-running-xemacs (string-match "XEmacs" emacs-version))
+
+(eval-and-compile
+  ;; save-current-buffer, with-current-buffer, and with-temp-buffer
+  ;; are not available in 19.34 and in older XEmacsen.  Strictly
+  ;; speaking, we should stick to our own namespace and define and use
+  ;; htmlize-save-current-buffer, etc.  But non-standard special forms
+  ;; are a pain because they're not properly fontified or indented and
+  ;; because they look weird and ugly.  So I'll just go ahead and
+  ;; define the real ones if they're not available.  If someone
+  ;; convinces me that this breaks something, I'll switch to the
+  ;; "htmlize-" namespace.
+  (unless (fboundp 'save-current-buffer)
+    (defmacro save-current-buffer (&rest forms)
+      `(let ((__scb_current (current-buffer)))
+	 (unwind-protect
+	     (progn ,@forms)
+	   (set-buffer __scb_current)))))
+  (unless (fboundp 'with-current-buffer)
+    (defmacro with-current-buffer (buffer &rest forms)
+      `(save-current-buffer (set-buffer ,buffer) ,@forms)))
+  (unless (fboundp 'with-temp-buffer)
+    (defmacro with-temp-buffer (&rest forms)
+      (let ((temp-buffer (gensym "tb-")))
+	`(let ((,temp-buffer
+		(get-buffer-create (generate-new-buffer-name " *temp*"))))
+	   (unwind-protect
+	       (with-current-buffer ,temp-buffer
+		 ,@forms)
+	     (and (buffer-live-p ,temp-buffer)
+		  (kill-buffer ,temp-buffer))))))))
+
+;; We need a function that efficiently finds the next change of a
+;; property (usually `face'), preferably regardless of whether the
+;; change occurred because of a text property or an extent/overlay.
+;; As it turns out, it is not easy to do that compatibly.
+;;
+;; Under XEmacs, `next-single-property-change' does that.  Under GNU
+;; Emacs beginning with version 21, `next-single-char-property-change'
+;; is available and does the same.  GNU Emacs 20 had
+;; `next-char-property-change', which we can use.  GNU Emacs 19 didn't
+;; provide any means for simultaneously examining overlays and text
+;; properties, so when using Emacs 19.34, we punt and fall back to
+;; `next-single-property-change', thus ignoring overlays altogether.
+
+(cond
+ (htmlize-running-xemacs
+  ;; XEmacs: good.
+  (defun htmlize-next-change (pos prop &optional limit)
+    (next-single-property-change pos prop nil (or limit (point-max)))))
+ ((fboundp 'next-single-char-property-change)
+  ;; GNU Emacs 21: good.
+  (defun htmlize-next-change (pos prop &optional limit)
+    (next-single-char-property-change pos prop nil limit)))
+ ((fboundp 'next-char-property-change)
+  ;; GNU Emacs 20: bad, but fixable.
+  (defun htmlize-next-change (pos prop &optional limit)
+    (let ((done nil)
+	  (current-value (get-char-property pos prop))
+	  newpos next-value)
+      ;; Loop over positions returned by next-char-property-change
+      ;; until the value of PROP changes or we've hit EOB.
+      (while (not done)
+	(setq newpos (next-char-property-change pos limit)
+	      next-value (get-char-property newpos prop))
+	(cond ((eq newpos pos)
+	       ;; Possibly at EOB?  Whatever, just don't infloop.
+	       (setq done t))
+	      ((eq next-value current-value)
+	       ;; PROP hasn't changed -- keep looping.
+	       )
+	      (t
+	       (setq done t)))
+	(setq pos newpos))
+      pos)))
+ (t
+  ;; GNU Emacs 19.34: hopeless, cannot properly support overlays.
+  (defun htmlize-next-change (pos prop &optional limit)
+    (unless limit
+      (setq limit (point-max)))
+    (let ((res (next-single-property-change pos prop)))
+      (if (or (null res)
+	      (> res limit))
+	  limit
+	res)))))
+
+;;; Transformation of buffer text: HTML escapes, untabification, etc.
+
+(defvar htmlize-basic-character-table
+  ;; Map characters in the 0-127 range to either one-character strings
+  ;; or to numeric entities.
+  (let ((table (make-vector 128 ?\0)))
+    ;; Map characters in the 32-126 range to themselves, others to
+    ;; &#CODE entities;
+    (dotimes (i 128)
+      (setf (aref table i) (if (and (>= i 32) (<= i 126))
+			       (char-to-string i)
+			     (format "&#%d;" i))))
+    ;; Set exceptions manually.
+    (setf
+     ;; Don't escape newline, carriage return, and TAB.
+     (aref table ?\n) "\n"
+     (aref table ?\r) "\r"
+     (aref table ?\t) "\t"
+     ;; Escape &, <, and >.
+     (aref table ?&) "&"
+     (aref table ?<) "<"
+     (aref table ?>) ">"
+     ;; Not escaping '"' buys us a measurable speedup.  It's only
+     ;; necessary to quote it for strings used in attribute values,
+     ;; which htmlize doesn't do.
+     ;(aref table ?\") """
+     )
+    table))
+
+;; A cache of HTML representation of non-ASCII characters.  Depending
+;; on availability of `encode-char' and the setting of
+;; `htmlize-convert-nonascii-to-entities', this maps non-ASCII
+;; characters to either "&#;" or "" (mapconcat's mapper
+;; must always return strings).  It's only filled as characters are
+;; encountered, so that in a buffer with e.g. French text, it will
+;; only ever contain French accented characters as keys.  It's cleared
+;; on each entry to htmlize-buffer-1 to allow modifications of
+;; `htmlize-convert-nonascii-to-entities' to take effect.
+(defvar htmlize-extended-character-cache (make-hash-table :test 'eq))
+
+(defun htmlize-protect-string (string)
+  "HTML-protect string, escaping HTML metacharacters and I18N chars."
+  ;; Only protecting strings that actually contain unsafe or non-ASCII
+  ;; chars removes a lot of unnecessary funcalls and consing.
+  (if (not (string-match "[^\r\n\t -%'-;=?-~]" string))
+      string
+    (mapconcat (lambda (char)
+		 (cond
+		  ((< char 128)
+		   ;; ASCII: use htmlize-basic-character-table.
+		   (aref htmlize-basic-character-table char))
+		  ((gethash char htmlize-extended-character-cache)
+		   ;; We've already seen this char; return the cached
+		   ;; string.
+		   )
+		  ((not htmlize-convert-nonascii-to-entities)
+		   ;; If conversion to entities is not desired, always
+		   ;; copy the char literally.
+		   (setf (gethash char htmlize-extended-character-cache)
+			 (char-to-string char)))
+		  ((< char 256)
+		   ;; Latin 1: no need to call encode-char.
+		   (setf (gethash char htmlize-extended-character-cache)
+			 (format "&#%d;" char)))
+		  ((and (fboundp 'encode-char)
+			;; Must check if encode-char works for CHAR;
+			;; it fails for Arabic and possibly elsewhere.
+			(encode-char char 'ucs))
+		   (setf (gethash char htmlize-extended-character-cache)
+			 (format "&#%d;" (encode-char char 'ucs))))
+		  (t
+		   ;; encode-char doesn't work for this char.  Copy it
+		   ;; unchanged and hope for the best.
+		   (setf (gethash char htmlize-extended-character-cache)
+			 (char-to-string char)))))
+	       string "")))
+
+(defconst htmlize-ellipsis "...")
+(put-text-property 0 (length htmlize-ellipsis) 'htmlize-ellipsis t htmlize-ellipsis)
+
+(defun htmlize-buffer-substring-no-invisible (beg end)
+  ;; Like buffer-substring-no-properties, but don't copy invisible
+  ;; parts of the region.  Where buffer-substring-no-properties
+  ;; mandates an ellipsis to be shown, htmlize-ellipsis is inserted.
+  (let ((pos beg)
+	visible-list invisible show next-change)
+    ;; Iterate over the changes in the `invisible' property and filter
+    ;; out the portions where it's non-nil, i.e. where the text is
+    ;; invisible.
+    (while (< pos end)
+      (setq invisible (get-char-property pos 'invisible)
+	    next-change (htmlize-next-change pos 'invisible end))
+      (if (not (listp buffer-invisibility-spec))
+	  ;; If buffer-invisibility-spec is not a list, then all
+	  ;; characters with non-nil `invisible' property are visible.
+	  (setq show (not invisible))
+	;; Otherwise, the value of a non-nil `invisible' property can be:
+	;; 1. a symbol -- make the text invisible if it matches
+	;;    buffer-invisibility-spec.
+	;; 2. a list of symbols -- make the text invisible if
+	;;    any symbol in the list matches
+	;;    buffer-invisibility-spec.
+	;; If the match of buffer-invisibility-spec has a non-nil
+	;; CDR, replace the invisible text with an ellipsis.
+	(let (match)
+	  (if (symbolp invisible)
+	      (setq match (member* invisible buffer-invisibility-spec
+				   :key (lambda (i)
+					  (if (symbolp i) i (car i)))))
+	    (setq match (block nil
+			  (dolist (elem invisible)
+			    (let ((m (member*
+				      elem buffer-invisibility-spec
+				      :key (lambda (i)
+					     (if (symbolp i) i (car i))))))
+			      (when m (return m))))
+			  nil)))
+	  (setq show (cond ((null match) t)
+			   ((and (cdr-safe (car match))
+				 ;; Conflate successive ellipses.
+				 (not (eq show htmlize-ellipsis)))
+			    htmlize-ellipsis)
+			   (t nil)))))
+      (cond ((eq show t)
+	     (push (buffer-substring-no-properties pos next-change) visible-list))
+	    ((stringp show)
+	     (push show visible-list)))
+      (setq pos next-change))
+    (if (= (length visible-list) 1)
+	;; If VISIBLE-LIST consists of only one element, return it
+	;; without concatenation.  This avoids additional consing in
+	;; regions without any invisible text.
+	(car visible-list)
+      (apply #'concat (nreverse visible-list)))))
+
+(defun htmlize-trim-ellipsis (text)
+  ;; Remove htmlize-ellipses ("...") from the beginning of TEXT if it
+  ;; starts with it.  It checks for the special property of the
+  ;; ellipsis so it doesn't work on ordinary text that begins with
+  ;; "...".
+  (if (get-text-property 0 'htmlize-ellipsis text)
+      (substring text (length htmlize-ellipsis))
+    text))
+
+(defconst htmlize-tab-spaces
+  ;; A table of strings with spaces.  (aref htmlize-tab-spaces 5) is
+  ;; like (make-string 5 ?\ ), except it doesn't cons.
+  (let ((v (make-vector 32 nil)))
+    (dotimes (i (length v))
+      (setf (aref v i) (make-string i ?\ )))
+    v))
+
+(defun htmlize-untabify (text start-column)
+  "Untabify TEXT, assuming it starts at START-COLUMN."
+  (let ((column start-column)
+	(last-match 0)
+	(chunk-start 0)
+	chunks match-pos tab-size)
+    (while (string-match "[\t\n]" text last-match)
+      (setq match-pos (match-beginning 0))
+      (cond ((eq (aref text match-pos) ?\t)
+	     ;; Encountered a tab: create a chunk of text followed by
+	     ;; the expanded tab.
+	     (push (substring text chunk-start match-pos) chunks)
+	     ;; Increase COLUMN by the length of the text we've
+	     ;; skipped since last tab or newline.  (Encountering
+	     ;; newline resets it.)
+	     (incf column (- match-pos last-match))
+	     ;; Calculate tab size based on tab-width and COLUMN.
+	     (setq tab-size (- tab-width (% column tab-width)))
+	     ;; Expand the tab.
+	     (push (aref htmlize-tab-spaces tab-size) chunks)
+	     (incf column tab-size)
+	     (setq chunk-start (1+ match-pos)))
+	    (t
+	     ;; Reset COLUMN at beginning of line.
+	     (setq column 0)))
+      (setq last-match (1+ match-pos)))
+    ;; If no chunks have been allocated, it means there have been no
+    ;; tabs to expand.  Return TEXT unmodified.
+    (if (null chunks)
+	text
+      (when (< chunk-start (length text))
+	;; Push the remaining chunk.
+	(push (substring text chunk-start) chunks))
+      ;; Generate the output from the available chunks.
+      (apply #'concat (nreverse chunks)))))
+
+(defun htmlize-despam-address (string)
+  "Replace every occurrence of '@' in STRING with @.
+`htmlize-make-hyperlinks' uses this to spam-protect mailto links
+without modifying their meaning."
+  ;; Suggested by Ville Skytta.
+  (while (string-match "@" string)
+    (setq string (replace-match "@" nil t string)))
+  string)
+
+(defun htmlize-make-hyperlinks ()
+  "Make hyperlinks in HTML."
+  ;; Function originally submitted by Ville Skytta.  Rewritten by
+  ;; Hrvoje Niksic, then modified by Ville Skytta and Hrvoje Niksic.
+  (goto-char (point-min))
+  (while (re-search-forward
+	  "<\\(\\(mailto:\\)?\\([-=+_.a-zA-Z0-9]+@[-_.a-zA-Z0-9]+\\)\\)>"
+	  nil t)
+    (let ((address (match-string 3))
+	  (link-text (match-string 1)))
+      (delete-region (match-beginning 0) (match-end 0))
+      (insert "<"
+	      (htmlize-despam-address link-text)
+	      ">")))
+  (goto-char (point-min))
+  (while (re-search-forward "<\\(\\(URL:\\)?\\([a-zA-Z]+://[^;]+\\)\\)>"
+			    nil t)
+    (let ((url (match-string 3))
+	  (link-text (match-string 1)))
+      (delete-region (match-beginning 0) (match-end 0))
+      (insert "<" link-text ">"))))
+
+;; Tests for htmlize-make-hyperlinks:
+
+;; 
+;; 
+;; 
+;; 
+;; 
+;; 
+
+(defun htmlize-defang-local-variables ()
+  ;; Juri Linkov reports that an HTML-ized "Local variables" can lead
+  ;; visiting the HTML to fail with "Local variables list is not
+  ;; properly terminated".  He suggested changing the phrase to
+  ;; syntactically equivalent HTML that Emacs doesn't recognize.
+  (goto-char (point-min))
+  (while (search-forward "Local Variables:" nil t)
+    (replace-match "Local Variables:" nil t)))
+  
+
+;;; Color handling.
+
+(if (fboundp 'locate-file)
+    (defalias 'htmlize-locate-file 'locate-file)
+  (defun htmlize-locate-file (file path)
+    (dolist (dir path nil)
+      (when (file-exists-p (expand-file-name file dir))
+	(return (expand-file-name file dir))))))
+
+(defvar htmlize-x-library-search-path
+  '("/usr/X11R6/lib/X11/"
+    "/usr/X11R5/lib/X11/"
+    "/usr/lib/X11R6/X11/"
+    "/usr/lib/X11R5/X11/"
+    "/usr/local/X11R6/lib/X11/"
+    "/usr/local/X11R5/lib/X11/"
+    "/usr/local/lib/X11R6/X11/"
+    "/usr/local/lib/X11R5/X11/"
+    "/usr/X11/lib/X11/"
+    "/usr/lib/X11/"
+    "/usr/local/lib/X11/"
+    "/usr/X386/lib/X11/"
+    "/usr/x386/lib/X11/"
+    "/usr/XFree86/lib/X11/"
+    "/usr/unsupported/lib/X11/"
+    "/usr/athena/lib/X11/"
+    "/usr/local/x11r5/lib/X11/"
+    "/usr/lpp/Xamples/lib/X11/"
+    "/usr/openwin/lib/X11/"
+    "/usr/openwin/share/lib/X11/"))
+
+(defun htmlize-get-color-rgb-hash (&optional rgb-file)
+  "Return a hash table mapping X color names to RGB values.
+The keys in the hash table are X11 color names, and the values are the
+#rrggbb RGB specifications, extracted from `rgb.txt'.
+
+If RGB-FILE is nil, the function will try hard to find a suitable file
+in the system directories.
+
+If no rgb.txt file is found, return nil."
+  (let ((rgb-file (or rgb-file (htmlize-locate-file
+				"rgb.txt"
+				htmlize-x-library-search-path)))
+	(hash nil))
+    (when rgb-file
+      (with-temp-buffer
+	(insert-file-contents rgb-file)
+	(setq hash (make-hash-table :test 'equal))
+	(while (not (eobp))
+	  (cond ((looking-at "^\\s-*\\([!#]\\|$\\)")
+		 ;; Skip comments and empty lines.
+		 )
+		((looking-at
+		  "[ \t]*\\([0-9]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\(.*\\)")
+		 (setf (gethash (downcase (match-string 4)) hash)
+		       (format "#%02x%02x%02x"
+			       (string-to-number (match-string 1))
+			       (string-to-number (match-string 2))
+			       (string-to-number (match-string 3)))))
+		(t
+		 (error
+		  "Unrecognized line in %s: %s"
+		  rgb-file
+		  (buffer-substring (point) (progn (end-of-line) (point))))))
+	  (forward-line 1))))
+    hash))
+
+;; Compile the RGB map when loaded.  On systems where rgb.txt is
+;; missing, the value of the variable will be nil, and rgb.txt will
+;; not be used.
+(defvar htmlize-color-rgb-hash (htmlize-get-color-rgb-hash))
+
+;;; Face handling.
+
+(defun htmlize-face-specifies-property (face prop)
+  ;; Return t if face specifies PROP, as opposed to it being inherited
+  ;; from the default face.  The problem with e.g.
+  ;; `face-foreground-instance' is that it returns an instance for
+  ;; EVERY face because every face inherits from the default face.
+  ;; However, we'd like htmlize-face-{fore,back}ground to return nil
+  ;; when called with a face that doesn't specify its own foreground
+  ;; or background.
+  (or (eq face 'default)
+      (assq 'global (specifier-spec-list (face-property face prop)))))
+
+(defun htmlize-face-color-internal (face fg)
+  ;; Used only under GNU Emacs.  Return the color of FACE, but don't
+  ;; return "unspecified-fg" or "unspecified-bg".  If the face is
+  ;; `default' and the color is unspecified, look up the color in
+  ;; frame parameters.
+  (let* ((function (if fg #'face-foreground #'face-background))
+	 color)
+    (if (>= emacs-major-version 22)
+	;; For GNU Emacs 22+ set INHERIT to get the inherited values.
+	(setq color (funcall function face nil t))
+      (setq color (funcall function face))
+      ;; For GNU Emacs 21 (which has `face-attribute'): if the color
+      ;; is nil, recursively check for the face's parent.
+      (when (and (null color)
+		 (fboundp 'face-attribute)
+		 (face-attribute face :inherit)
+		 (not (eq (face-attribute face :inherit) 'unspecified)))
+	(setq color (htmlize-face-color-internal
+		     (face-attribute face :inherit) fg))))
+    (when (and (eq face 'default) (null color))
+      (setq color (cdr (assq (if fg 'foreground-color 'background-color)
+			     (frame-parameters)))))
+    (when (or (eq color 'unspecified)
+	      (equal color "unspecified-fg")
+	      (equal color "unspecified-bg"))
+      (setq color nil))
+    (when (and (eq face 'default)
+	       (null color))
+      ;; Assuming black on white doesn't seem right, but I can't think
+      ;; of anything better to do.
+      (setq color (if fg "black" "white")))
+    color))
+
+(defun htmlize-face-foreground (face)
+  ;; Return the name of the foreground color of FACE.  If FACE does
+  ;; not specify a foreground color, return nil.
+  (cond (htmlize-running-xemacs
+	 ;; XEmacs.
+	 (and (htmlize-face-specifies-property face 'foreground)
+	      (color-instance-name (face-foreground-instance face))))
+	(t
+	 ;; GNU Emacs.
+	 (htmlize-face-color-internal face t))))
+
+(defun htmlize-face-background (face)
+  ;; Return the name of the background color of FACE.  If FACE does
+  ;; not specify a background color, return nil.
+  (cond (htmlize-running-xemacs
+	 ;; XEmacs.
+	 (and (htmlize-face-specifies-property face 'background)
+	      (color-instance-name (face-background-instance face))))
+	(t
+	 ;; GNU Emacs.
+	 (htmlize-face-color-internal face nil))))
+
+;; Convert COLOR to the #RRGGBB string.  If COLOR is already in that
+;; format, it's left unchanged.
+
+(defun htmlize-color-to-rgb (color)
+  (let ((rgb-string nil))
+    (cond ((null color)
+	   ;; Ignore nil COLOR because it means that the face is not
+	   ;; specifying any color.  Hence (htmlize-color-to-rgb nil)
+	   ;; returns nil.
+	   )
+	  ((string-match "\\`#" color)
+	   ;; The color is already in #rrggbb format.
+	   (setq rgb-string color))
+	  ((and htmlize-use-rgb-txt
+		htmlize-color-rgb-hash)
+	   ;; Use of rgb.txt is requested, and it's available on the
+	   ;; system.  Use it.
+	   (setq rgb-string (gethash (downcase color) htmlize-color-rgb-hash)))
+	  (t
+	   ;; We're getting the RGB components from Emacs.
+	   (let ((rgb
+		  ;; Here I cannot conditionalize on (fboundp ...) 
+		  ;; because ps-print under some versions of GNU Emacs
+		  ;; defines its own dummy version of
+		  ;; `color-instance-rgb-components'.
+		  (if htmlize-running-xemacs
+		      (mapcar (lambda (arg)
+				(/ arg 256))
+			      (color-instance-rgb-components
+			       (make-color-instance color)))
+		    (mapcar (lambda (arg)
+			      (/ arg 256))
+			    (x-color-values color)))))
+	     (when rgb
+	       (setq rgb-string (apply #'format "#%02x%02x%02x" rgb))))))
+    ;; If RGB-STRING is still nil, it means the color cannot be found,
+    ;; for whatever reason.  In that case just punt and return COLOR.
+    ;; Most browsers support a decent set of color names anyway.
+    (or rgb-string color)))
+
+;; We store the face properties we care about into an
+;; `htmlize-fstruct' type.  That way we only have to analyze face
+;; properties, which can be time consuming, once per each face.  The
+;; mapping between Emacs faces and htmlize-fstructs is established by
+;; htmlize-make-face-map.  The name "fstruct" refers to variables of
+;; type `htmlize-fstruct', while the term "face" is reserved for Emacs
+;; faces.
+
+(defstruct htmlize-fstruct
+  foreground				; foreground color, #rrggbb
+  background				; background color, #rrggbb
+  size					; size
+  boldp					; whether face is bold
+  italicp				; whether face is italic
+  underlinep				; whether face is underlined
+  overlinep				; whether face is overlined
+  strikep				; whether face is struck through
+  css-name				; CSS name of face
+  )
+
+(defun htmlize-face-emacs21-attr (fstruct attr value)
+  ;; For ATTR and VALUE, set the equivalent value in FSTRUCT.
+  (case attr
+    (:foreground
+     (setf (htmlize-fstruct-foreground fstruct) (htmlize-color-to-rgb value)))
+    (:background
+     (setf (htmlize-fstruct-background fstruct) (htmlize-color-to-rgb value)))
+    (:height
+     (setf (htmlize-fstruct-size fstruct) value))
+    (:weight
+     (when (string-match (symbol-name value) "bold")
+       (setf (htmlize-fstruct-boldp fstruct) t)))
+    (:slant
+     (setf (htmlize-fstruct-italicp fstruct) (or (eq value 'italic)
+						 (eq value 'oblique))))
+    (:bold
+     (setf (htmlize-fstruct-boldp fstruct) value))
+    (:italic
+     (setf (htmlize-fstruct-italicp fstruct) value))
+    (:underline
+     (setf (htmlize-fstruct-underlinep fstruct) value))
+    (:overline
+     (setf (htmlize-fstruct-overlinep fstruct) value))
+    (:strike-through
+     (setf (htmlize-fstruct-strikep fstruct) value))))
+
+(defun htmlize-face-size (face)
+  ;; The size (height) of FACE, taking inheritance into account.
+  ;; Only works in Emacs 21 and later.
+  (let ((size-list
+	 (loop
+	  for f = face then (face-attribute f :inherit)
+	  until (or (not f) (eq f 'unspecified))
+	  for h = (face-attribute f :height)
+	  collect (if (eq h 'unspecified) nil h))))
+    (reduce 'htmlize-merge-size (cons nil size-list))))
+
+(defun htmlize-face-to-fstruct (face)
+  "Convert Emacs face FACE to fstruct."
+  (let ((fstruct (make-htmlize-fstruct
+		  :foreground (htmlize-color-to-rgb
+			       (htmlize-face-foreground face))
+		  :background (htmlize-color-to-rgb
+			       (htmlize-face-background face)))))
+    (cond (htmlize-running-xemacs
+	   ;; XEmacs doesn't provide a way to detect whether a face is
+	   ;; bold or italic, so we need to examine the font instance.
+	   ;; #### This probably doesn't work under MS Windows and/or
+	   ;; GTK devices.  I'll need help with those.
+	   (let* ((font-instance (face-font-instance face))
+		  (props (font-instance-properties font-instance)))
+	     (when (equalp (cdr (assq 'WEIGHT_NAME props)) "bold")
+	       (setf (htmlize-fstruct-boldp fstruct) t))
+	     (when (or (equalp (cdr (assq 'SLANT props)) "i")
+		       (equalp (cdr (assq 'SLANT props)) "o"))
+	       (setf (htmlize-fstruct-italicp fstruct) t))
+	     (setf (htmlize-fstruct-strikep fstruct)
+		   (face-strikethru-p face))
+	     (setf (htmlize-fstruct-underlinep fstruct)
+		   (face-underline-p face))))
+	  ((fboundp 'face-attribute)
+	   ;; GNU Emacs 21 and further.
+	   (dolist (attr '(:weight :slant :underline :overline :strike-through))
+	     (let ((value (if (>= emacs-major-version 22)
+			      ;; Use the INHERIT arg in GNU Emacs 22.
+			      (face-attribute face attr nil t)
+			    ;; Otherwise, fake it.
+			    (let ((face face))
+			      (while (and (eq (face-attribute face attr)
+					      'unspecified)
+					  (not (eq (face-attribute face :inherit)
+						   'unspecified)))
+				(setq face (face-attribute face :inherit)))
+			      (face-attribute face attr)))))
+	       (when (and value (not (eq value 'unspecified)))
+		 (htmlize-face-emacs21-attr fstruct attr value))))
+	   (let ((size (htmlize-face-size face)))
+	     (unless (eql size 1.0) 	; ignore non-spec
+	       (setf (htmlize-fstruct-size fstruct) size))))
+	  (t
+	   ;; Older GNU Emacs.  Some of these functions are only
+	   ;; available under Emacs 20+, hence the guards.
+	   (when (fboundp 'face-bold-p)
+	     (setf (htmlize-fstruct-boldp fstruct) (face-bold-p face)))
+	   (when (fboundp 'face-italic-p)
+	     (setf (htmlize-fstruct-italicp fstruct) (face-italic-p face)))
+	   (setf (htmlize-fstruct-underlinep fstruct)
+		 (face-underline-p face))))
+    ;; Generate the css-name property.  Emacs places no restrictions
+    ;; on the names of symbols that represent faces -- any characters
+    ;; may be in the name, even ^@.  We try hard to beat the face name
+    ;; into shape, both esthetically and according to CSS1 specs.
+    (setf (htmlize-fstruct-css-name fstruct)
+	  (let ((name (downcase (symbol-name face))))
+	    (when (string-match "\\`font-lock-" name)
+	      ;; Change font-lock-FOO-face to FOO.
+	      (setq name (replace-match "" t t name)))
+	    (when (string-match "-face\\'" name)
+	      ;; Drop the redundant "-face" suffix.
+	      (setq name (replace-match "" t t name)))
+	    (while (string-match "[^-a-zA-Z0-9]" name)
+	      ;; Drop the non-alphanumerics.
+	      (setq name (replace-match "X" t t name)))
+	    (when (string-match "\\`[-0-9]" name)
+	      ;; CSS identifiers may not start with a digit.
+	      (setq name (concat "X" name)))
+	    ;; After these transformations, the face could come
+	    ;; out empty.
+	    (when (equal name "")
+	      (setq name "face"))
+	    ;; Apply the prefix.
+	    (setq name (concat htmlize-css-name-prefix name))
+	    name))
+    fstruct))
+
+(defmacro htmlize-copy-attr-if-set (attr-list dest source)
+  ;; Expand the code of the type
+  ;; (and (htmlize-fstruct-ATTR source)
+  ;;      (setf (htmlize-fstruct-ATTR dest) (htmlize-fstruct-ATTR source)))
+  ;; for the given list of boolean attributes.
+  (cons 'progn
+	(loop for attr in attr-list
+	      for attr-sym = (intern (format "htmlize-fstruct-%s" attr))
+	      collect `(and (,attr-sym ,source)
+			    (setf (,attr-sym ,dest) (,attr-sym ,source))))))
+
+(defun htmlize-merge-size (merged next)
+  ;; Calculate the size of the merge of MERGED and NEXT.
+  (cond ((null merged)     next)
+	((integerp next)   next)
+	((null next)       merged)
+	((floatp merged)   (* merged next))
+	((integerp merged) (round (* merged next)))))
+
+(defun htmlize-merge-two-faces (merged next)
+  (htmlize-copy-attr-if-set
+   (foreground background boldp italicp underlinep overlinep strikep)
+   merged next)
+  (setf (htmlize-fstruct-size merged)
+	(htmlize-merge-size (htmlize-fstruct-size merged)
+			    (htmlize-fstruct-size next)))
+  merged)
+
+(defun htmlize-merge-faces (fstruct-list)
+  (cond ((null fstruct-list)
+	 ;; Nothing to do, return a dummy face.
+	 (make-htmlize-fstruct))
+	((null (cdr fstruct-list))
+	 ;; Optimize for the common case of a single face, simply
+	 ;; return it.
+	 (car fstruct-list))
+	(t
+	 (reduce #'htmlize-merge-two-faces
+		 (cons (make-htmlize-fstruct) fstruct-list)))))
+
+;; GNU Emacs 20+ supports attribute lists in `face' properties.  For
+;; example, you can use `(:foreground "red" :weight bold)' as an
+;; overlay's "face", or you can even use a list of such lists, etc.
+;; We call those "attrlists".
+;;
+;; htmlize supports attrlist by converting them to fstructs, the same
+;; as with regular faces.
+
+(defun htmlize-attrlist-to-fstruct (attrlist)
+  ;; Like htmlize-face-to-fstruct, but accepts an ATTRLIST as input.
+  (let ((fstruct (make-htmlize-fstruct)))
+    (cond ((eq (car attrlist) 'foreground-color)
+	   ;; ATTRLIST is (foreground-color . COLOR)
+	   (setf (htmlize-fstruct-foreground fstruct)
+		 (htmlize-color-to-rgb (cdr attrlist))))
+	  ((eq (car attrlist) 'background-color)
+	   ;; ATTRLIST is (background-color . COLOR)
+	   (setf (htmlize-fstruct-background fstruct)
+		 (htmlize-color-to-rgb (cdr attrlist))))
+	  (t
+	   ;; ATTRLIST is a plist.
+	   (while attrlist
+	     (let ((attr (pop attrlist))
+		   (value (pop attrlist)))
+	       (when (and value (not (eq value 'unspecified)))
+		 (htmlize-face-emacs21-attr fstruct attr value))))))
+    (setf (htmlize-fstruct-css-name fstruct) "ATTRLIST")
+    fstruct))
+
+(defun htmlize-face-list-p (face-prop)
+  "Return non-nil if FACE-PROP is a list of faces, nil otherwise."
+  ;; If not for attrlists, this would return (listp face-prop).  This
+  ;; way we have to be more careful because attrlist is also a list!
+  (cond
+   ((eq face-prop nil)
+    ;; FACE-PROP being nil means empty list (no face), so return t.
+    t)
+   ((symbolp face-prop)
+    ;; A symbol other than nil means that it's only one face, so return
+    ;; nil.
+    nil)
+   ((not (consp face-prop))
+    ;; Huh?  Not a symbol or cons -- treat it as a single element.
+    nil)
+   (t
+    ;; We know that FACE-PROP is a cons: check whether it looks like an
+    ;; ATTRLIST.
+    (let* ((car (car face-prop))
+	   (attrlist-p (and (symbolp car)
+			    (or (eq car 'foreground-color)
+				(eq car 'background-color)
+				(eq (aref (symbol-name car) 0) ?:)))))
+      ;; If FACE-PROP is not an ATTRLIST, it means it's a list of
+      ;; faces.
+      (not attrlist-p)))))
+
+(defun htmlize-make-face-map (faces)
+  ;; Return a hash table mapping Emacs faces to htmlize's fstructs.
+  ;; The keys are either face symbols or attrlists, so the test
+  ;; function must be `equal'.
+  (let ((face-map (make-hash-table :test 'equal))
+	css-names)
+    (dolist (face faces)
+      (unless (gethash face face-map)
+	;; Haven't seen FACE yet; convert it to an fstruct and cache
+	;; it.
+	(let ((fstruct (if (symbolp face)
+			   (htmlize-face-to-fstruct face)
+			 (htmlize-attrlist-to-fstruct face))))
+	  (setf (gethash face face-map) fstruct)
+	  (let* ((css-name (htmlize-fstruct-css-name fstruct))
+		 (new-name css-name)
+		 (i 0))
+	    ;; Uniquify the face's css-name by using NAME-1, NAME-2,
+	    ;; etc.
+	    (while (member new-name css-names)
+	      (setq new-name (format "%s-%s" css-name (incf i))))
+	    (unless (equal new-name css-name)
+	      (setf (htmlize-fstruct-css-name fstruct) new-name))
+	    (push new-name css-names)))))
+    face-map))
+
+(defun htmlize-unstringify-face (face)
+  "If FACE is a string, return it interned, otherwise return it unchanged."
+  (if (stringp face)
+      (intern face)
+    face))
+
+(defun htmlize-faces-in-buffer ()
+  "Return a list of faces used in the current buffer.
+Under XEmacs, this returns the set of faces specified by the extents
+with the `face' property.  (This covers text properties as well.)  Under
+GNU Emacs, it returns the set of faces specified by the `face' text
+property and by buffer overlays that specify `face'."
+  (let (faces)
+    ;; Testing for (fboundp 'map-extents) doesn't work because W3
+    ;; defines `map-extents' under FSF.
+    (if htmlize-running-xemacs
+	(let (face-prop)
+	  (map-extents (lambda (extent ignored)
+			 (setq face-prop (extent-face extent)
+			       ;; FACE-PROP can be a face or a list of
+			       ;; faces.
+			       faces (if (listp face-prop)
+					 (union face-prop faces)
+				       (adjoin face-prop faces)))
+			 nil)
+		       nil
+		       ;; Specify endpoints explicitly to respect
+		       ;; narrowing.
+		       (point-min) (point-max) nil nil 'face))
+      ;; FSF Emacs code.
+      ;; Faces used by text properties.
+      (let ((pos (point-min)) face-prop next)
+	(while (< pos (point-max))
+	  (setq face-prop (get-text-property pos 'face)
+		next (or (next-single-property-change pos 'face) (point-max)))
+	  ;; FACE-PROP can be a face/attrlist or a list thereof.
+	  (setq faces (if (htmlize-face-list-p face-prop)
+			  (nunion (mapcar #'htmlize-unstringify-face face-prop)
+				  faces :test 'equal)
+			(adjoin (htmlize-unstringify-face face-prop)
+				faces :test 'equal)))
+	  (setq pos next)))
+      ;; Faces used by overlays.
+      (dolist (overlay (overlays-in (point-min) (point-max)))
+	(let ((face-prop (overlay-get overlay 'face)))
+	  ;; FACE-PROP can be a face/attrlist or a list thereof.
+	  (setq faces (if (htmlize-face-list-p face-prop)
+			  (nunion (mapcar #'htmlize-unstringify-face face-prop)
+				  faces :test 'equal)
+			(adjoin (htmlize-unstringify-face face-prop)
+				faces :test 'equal))))))
+    faces))
+
+;; htmlize-faces-at-point returns the faces in use at point.  The
+;; faces are sorted by increasing priority, i.e. the last face takes
+;; precedence.
+;;
+;; Under XEmacs, this returns all the faces in all the extents at
+;; point.  Under GNU Emacs, this returns all the faces in the `face'
+;; property and all the faces in the overlays at point.
+
+(cond (htmlize-running-xemacs
+       (defun htmlize-faces-at-point ()
+	 (let (extent extent-list face-list face-prop)
+	   (while (setq extent (extent-at (point) nil 'face extent))
+	     (push extent extent-list))
+	   ;; extent-list is in reverse display order, meaning that
+	   ;; smallest ones come last.  That is the order we want,
+	   ;; except it can be overridden by the `priority' property.
+	   (setq extent-list (stable-sort extent-list #'<
+					  :key #'extent-priority))
+	   (dolist (extent extent-list)
+	     (setq face-prop (extent-face extent))
+	     ;; extent's face-list is in reverse order from what we
+	     ;; want, but the `nreverse' below will take care of it.
+	     (setq face-list (if (listp face-prop)
+				 (append face-prop face-list)
+			       (cons face-prop face-list))))
+	   (nreverse face-list))))
+      (t
+       (defun htmlize-faces-at-point ()
+	 (let (all-faces)
+	   ;; Faces from text properties.
+	   (let ((face-prop (get-text-property (point) 'face)))
+	     (setq all-faces (if (htmlize-face-list-p face-prop)
+				 (nreverse (mapcar #'htmlize-unstringify-face
+						   face-prop))
+			       (list (htmlize-unstringify-face face-prop)))))
+	   ;; Faces from overlays.
+	   (let ((overlays
+		  ;; Collect overlays at point that specify `face'.
+		  (delete-if-not (lambda (o)
+				   (overlay-get o 'face))
+				 (overlays-at (point))))
+		 list face-prop)
+	     ;; Sort the overlays so the smaller (more specific) ones
+	     ;; come later.  The number of overlays at each one
+	     ;; position should be very small, so the sort shouldn't
+	     ;; slow things down.
+	     (setq overlays (sort* overlays
+				   ;; Sort by ascending...
+				   #'<
+				   ;; ...overlay size.
+				   :key (lambda (o)
+					  (- (overlay-end o)
+					     (overlay-start o)))))
+	     ;; Overlay priorities, if present, override the above
+	     ;; established order.  Larger overlay priority takes
+	     ;; precedence and therefore comes later in the list.
+	     (setq overlays (stable-sort
+			     overlays
+			     ;; Reorder (stably) by acending...
+			     #'<
+			     ;; ...overlay priority.
+			     :key (lambda (o)
+				    (or (overlay-get o 'priority) 0))))
+	     (dolist (overlay overlays)
+	       (setq face-prop (overlay-get overlay 'face))
+	       (setq list (if (htmlize-face-list-p face-prop)
+			      (nconc (nreverse (mapcar
+						#'htmlize-unstringify-face
+						face-prop))
+				     list)
+			    (cons (htmlize-unstringify-face face-prop) list))))
+	     ;; Under "Merging Faces" the manual explicitly states
+	     ;; that faces specified by overlays take precedence over
+	     ;; faces specified by text properties.
+	     (setq all-faces (nconc all-faces list)))
+	   all-faces))))
+
+;; htmlize supports generating HTML in two several fundamentally
+;; different ways, one with the use of CSS and nested  tags, and
+;; the other with the use of the old  tags.  Rather than adding
+;; a bunch of ifs to many places, we take a semi-OO approach.
+;; `htmlize-buffer-1' calls a number of "methods", which indirect to
+;; the functions that depend on `htmlize-output-type'.  The currently
+;; used methods are `doctype', `insert-head', `body-tag', and
+;; `insert-text'.  Not all output types define all methods.
+;;
+;; Methods are called either with (htmlize-method METHOD ARGS...) 
+;; special form, or by accessing the function with
+;; (htmlize-method-function 'METHOD) and calling (funcall FUNCTION).
+;; The latter form is useful in tight loops because `htmlize-method'
+;; conses.
+;;
+;; Currently defined output types are `css' and `font'.
+
+(defmacro htmlize-method (method &rest args)
+  ;; Expand to (htmlize-TYPE-METHOD ...ARGS...).  TYPE is the value of
+  ;; `htmlize-output-type' at run time.
+  `(funcall (htmlize-method-function ',method) ,@args))
+
+(defun htmlize-method-function (method)
+  ;; Return METHOD's function definition for the current output type.
+  ;; The returned object can be safely funcalled.
+  (let ((sym (intern (format "htmlize-%s-%s" htmlize-output-type method))))
+    (indirect-function (if (fboundp sym)
+			   sym
+			 (let ((default (intern (concat "htmlize-default-"
+							(symbol-name method)))))
+			   (if (fboundp default)
+			       default
+			     'ignore))))))
+
+(defvar htmlize-memoization-table (make-hash-table :test 'equal))
+
+(defmacro htmlize-memoize (key generator)
+  "Return the value of GENERATOR, memoized as KEY.
+That means that GENERATOR will be evaluated and returned the first time
+it's called with the same value of KEY.  All other times, the cached
+\(memoized) value will be returned."
+  (let ((value (gensym)))
+    `(let ((,value (gethash ,key htmlize-memoization-table)))
+       (unless ,value
+	 (setq ,value ,generator)
+	 (setf (gethash ,key htmlize-memoization-table) ,value))
+       ,value)))
+
+;;; Default methods.
+
+(defun htmlize-default-doctype ()
+  nil					; no doc-string
+  ;; According to DTDs published by the W3C, it is illegal to embed
+  ;;  in 
.  This makes sense in general, but is bad for
+  ;; htmlize's intended usage of  to specify the document color.
+
+  ;; To make generated HTML legal, htmlize's `font' mode used to
+  ;; specify the SGML declaration of "HTML Pro" DTD here.  HTML Pro
+  ;; aka Silmaril DTD was a project whose goal was to produce a GPL'ed
+  ;; DTD that would encompass all the incompatible HTML extensions
+  ;; procured by Netscape, MSIE, and other players in the field.
+  ;; Apparently the project got abandoned, the last available version
+  ;; being "Draft 0 Revision 11" from January 1997, as documented at
+  ;; .
+
+  ;; Since by now HTML Pro is remembered by none but the most die-hard
+  ;; early-web-days nostalgics and used by not even them, there is no
+  ;; use in specifying it.  So we return the standard HTML 4.0
+  ;; declaration, which makes generated HTML technically illegal.  If
+  ;; you have a problem with that, use the `css' engine designed to
+  ;; create fully conforming HTML.
+
+  ""
+
+  ;; Now-abandoned HTML Pro declaration.
+  ;""
+  )
+
+(defun htmlize-default-body-tag (face-map)
+  nil					; no doc-string
+  "")
+
+;;; CSS based output support.
+
+;; Internal function; not a method.
+(defun htmlize-css-specs (fstruct)
+  (let (result)
+    (when (htmlize-fstruct-foreground fstruct)
+      (push (format "color: %s;" (htmlize-fstruct-foreground fstruct))
+	    result))
+    (when (htmlize-fstruct-background fstruct)
+      (push (format "background-color: %s;"
+		    (htmlize-fstruct-background fstruct))
+	    result))
+    (let ((size (htmlize-fstruct-size fstruct)))
+      (when (and size (not (eq htmlize-ignore-face-size t)))
+	(cond ((floatp size)
+	       (push (format "font-size: %d%%;" (* 100 size)) result))
+	      ((not (eq htmlize-ignore-face-size 'absolute))
+	       (push (format "font-size: %spt;" (/ size 10.0)) result)))))
+    (when (htmlize-fstruct-boldp fstruct)
+      (push "font-weight: bold;" result))
+    (when (htmlize-fstruct-italicp fstruct)
+      (push "font-style: italic;" result))
+    (when (htmlize-fstruct-underlinep fstruct)
+      (push "text-decoration: underline;" result))
+    (when (htmlize-fstruct-overlinep fstruct)
+      (push "text-decoration: overline;" result))
+    (when (htmlize-fstruct-strikep fstruct)
+      (push "text-decoration: line-through;" result))
+    (nreverse result)))
+
+(defun htmlize-css-insert-head (buffer-faces face-map)
+  (insert "    \n"))
+
+(defun htmlize-css-insert-text (text fstruct-list buffer)
+  ;; Insert TEXT colored with FACES into BUFFER.  In CSS mode, this is
+  ;; easy: just nest the text in one  tag for each
+  ;; face in FSTRUCT-LIST.
+  (dolist (fstruct fstruct-list)
+    (princ "" buffer))
+  (princ text buffer)
+  (dolist (fstruct fstruct-list)
+    (ignore fstruct)			; shut up the byte-compiler
+    (princ "" buffer)))
+
+;; `inline-css' output support.
+
+(defun htmlize-inline-css-body-tag (face-map)
+  (format ""
+	  (mapconcat #'identity (htmlize-css-specs (gethash 'default face-map))
+		     " ")))
+
+(defun htmlize-inline-css-insert-text (text fstruct-list buffer)
+  (let* ((merged (htmlize-merge-faces fstruct-list))
+	 (style (htmlize-memoize
+		 merged
+		 (let ((specs (htmlize-css-specs merged)))
+		   (and specs
+			(mapconcat #'identity (htmlize-css-specs merged) " "))))))
+    (when style
+      (princ "" buffer))
+    (princ text buffer)
+    (when style
+      (princ "" buffer))))
+
+;;; `font' tag based output support.
+
+(defun htmlize-font-body-tag (face-map)
+  (let ((fstruct (gethash 'default face-map)))
+    (format ""
+	    (htmlize-fstruct-foreground fstruct)
+	    (htmlize-fstruct-background fstruct))))
+       
+(defun htmlize-font-insert-text (text fstruct-list buffer)
+  ;; In `font' mode, we use the traditional HTML means of altering
+  ;; presentation:  tag for colors,  for bold,  for
+  ;; underline, and  for strike-through.
+  (let* ((merged (htmlize-merge-faces fstruct-list))
+	 (markup (htmlize-memoize
+		  merged
+		  (cons (concat
+			 (and (htmlize-fstruct-foreground merged)
+			      (format "" (htmlize-fstruct-foreground merged)))
+			 (and (htmlize-fstruct-boldp merged)      "")
+			 (and (htmlize-fstruct-italicp merged)    "")
+			 (and (htmlize-fstruct-underlinep merged) "")
+			 (and (htmlize-fstruct-strikep merged)    ""))
+			(concat
+			 (and (htmlize-fstruct-strikep merged)    "")
+			 (and (htmlize-fstruct-underlinep merged) "")
+			 (and (htmlize-fstruct-italicp merged)    "")
+			 (and (htmlize-fstruct-boldp merged)      "")
+			 (and (htmlize-fstruct-foreground merged) ""))))))
+    (princ (car markup) buffer)
+    (princ text buffer)
+    (princ (cdr markup) buffer)))
+
+(defun htmlize-buffer-1 ()
+  ;; Internal function; don't call it from outside this file.  Htmlize
+  ;; current buffer, writing the resulting HTML to a new buffer, and
+  ;; return it.  Unlike htmlize-buffer, this doesn't change current
+  ;; buffer or use switch-to-buffer.
+  (save-excursion
+    ;; Protect against the hook changing the current buffer.
+    (save-excursion
+      (run-hooks 'htmlize-before-hook))
+    ;; Convince font-lock support modes to fontify the entire buffer
+    ;; in advance.
+    (htmlize-ensure-fontified)
+    (clrhash htmlize-extended-character-cache)
+    (clrhash htmlize-memoization-table)
+    (let* ((buffer-faces (htmlize-faces-in-buffer))
+	   (face-map (htmlize-make-face-map (adjoin 'default buffer-faces)))
+	   ;; Generate the new buffer.  It's important that it inherits
+	   ;; default-directory from the current buffer.
+	   (htmlbuf (generate-new-buffer (if (buffer-file-name)
+					     (htmlize-make-file-name
+					      (file-name-nondirectory
+					       (buffer-file-name)))
+					   "*html*")))
+	   ;; Having a dummy value in the plist allows writing simply
+	   ;; (plist-put places foo bar).
+	   (places '(nil nil))
+	   (title (if (buffer-file-name)
+		      (file-name-nondirectory (buffer-file-name))
+		    (buffer-name))))
+      ;; Initialize HTMLBUF and insert the HTML prolog.
+      (with-current-buffer htmlbuf
+	(buffer-disable-undo)
+	(insert (htmlize-method doctype) ?\n
+		(format "\n"
+			htmlize-version htmlize-output-type)
+		"\n  ")
+	(plist-put places 'head-start (point-marker))
+	(insert "\n"
+		"    " (htmlize-protect-string title) "\n"
+		(if htmlize-html-charset
+		    (format (concat "    \n")
+			    htmlize-html-charset)
+		  "")
+		htmlize-head-tags)
+	(htmlize-method insert-head buffer-faces face-map)
+	(insert "  ")
+	(plist-put places 'head-end (point-marker))
+	(insert "\n  ")
+	(plist-put places 'body-start (point-marker))
+	(insert (htmlize-method body-tag face-map)
+		"\n    ")
+	(plist-put places 'content-start (point-marker))
+	(insert "
\n"))
+      (let ((insert-text-method
+	     ;; Get the inserter method, so we can funcall it inside
+	     ;; the loop.  Not calling `htmlize-method' in the loop
+	     ;; body yields a measurable speed increase.
+	     (htmlize-method-function 'insert-text))
+	    ;; Declare variables used in loop body outside the loop
+	    ;; because it's faster to establish `let' bindings only
+	    ;; once.
+	    next-change text face-list fstruct-list trailing-ellipsis)
+	;; This loop traverses and reads the source buffer, appending
+	;; the resulting HTML to HTMLBUF with `princ'.  This method is
+	;; fast because: 1) it doesn't require examining the text
+	;; properties char by char (htmlize-next-change is used to
+	;; move between runs with the same face), and 2) it doesn't
+	;; require buffer switches, which are slow in Emacs.
+	(goto-char (point-min))
+	(while (not (eobp))
+	  (setq next-change (htmlize-next-change (point) 'face))
+	  ;; Get faces in use between (point) and NEXT-CHANGE, and
+	  ;; convert them to fstructs.
+	  (setq face-list (htmlize-faces-at-point)
+		fstruct-list (delq nil (mapcar (lambda (f)
+						 (gethash f face-map))
+					       face-list)))
+	  ;; Extract buffer text, sans the invisible parts.  Then
+	  ;; untabify it and escape the HTML metacharacters.
+	  (setq text (htmlize-buffer-substring-no-invisible
+		      (point) next-change))
+	  (when trailing-ellipsis
+	    (setq text (htmlize-trim-ellipsis text)))
+	  ;; If TEXT ends up empty, don't change trailing-ellipsis.
+	  (when (> (length text) 0)
+	    (setq trailing-ellipsis
+		  (get-text-property (1- (length text))
+				     'htmlize-ellipsis text)))
+	  (setq text (htmlize-untabify text (current-column)))
+	  (setq text (htmlize-protect-string text))
+	  ;; Don't bother writing anything if there's no text (this
+	  ;; happens in invisible regions).
+	  (when (> (length text) 0)
+	    ;; Insert the text, along with the necessary markup to
+	    ;; represent faces in FSTRUCT-LIST.
+	    (funcall insert-text-method text fstruct-list htmlbuf))
+	  (goto-char next-change)))
+
+      ;; Insert the epilog and post-process the buffer.
+      (with-current-buffer htmlbuf
+	(insert "
")
+	(plist-put places 'content-end (point-marker))
+	(insert "\n  ")
+	(plist-put places 'body-end (point-marker))
+	(insert "\n\n")
+	(when htmlize-generate-hyperlinks
+	  (htmlize-make-hyperlinks))
+	(htmlize-defang-local-variables)
+	(when htmlize-replace-form-feeds
+	  ;; Change each "\n^L" to "
".
+	  (goto-char (point-min))
+	  (let ((source
+		 ;; ^L has already been escaped, so search for that.
+		 (htmlize-protect-string "\n\^L"))
+		(replacement
+		 (if (stringp htmlize-replace-form-feeds)
+		     htmlize-replace-form-feeds
+		   "
")))
+	    (while (search-forward source nil t)
+	      (replace-match replacement t t))))
+	(goto-char (point-min))
+	(when htmlize-html-major-mode
+	  ;; What sucks about this is that the minor modes, most notably
+	  ;; font-lock-mode, won't be initialized.  Oh well.
+	  (funcall htmlize-html-major-mode))
+	(set (make-local-variable 'htmlize-buffer-places) places)
+	(run-hooks 'htmlize-after-hook)
+	(buffer-enable-undo))
+      htmlbuf)))
+
+;; Utility functions.
+
+(defmacro htmlize-with-fontify-message (&rest body)
+  ;; When forcing fontification of large buffers in
+  ;; htmlize-ensure-fontified, inform the user that he is waiting for
+  ;; font-lock, not for htmlize to finish.
+  `(progn
+     (if (> (buffer-size) 65536)
+	 (message "Forcing fontification of %s..."
+		  (buffer-name (current-buffer))))
+     ,@body
+     (if (> (buffer-size) 65536)
+	 (message "Forcing fontification of %s...done"
+		  (buffer-name (current-buffer))))))
+
+(defun htmlize-ensure-fontified ()
+  ;; If font-lock is being used, ensure that the "support" modes
+  ;; actually fontify the buffer.  If font-lock is not in use, we
+  ;; don't care because, except in htmlize-file, we don't force
+  ;; font-lock on the user.
+  (when (and (boundp 'font-lock-mode)
+	     font-lock-mode)
+    ;; In part taken from ps-print-ensure-fontified in GNU Emacs 21.
+    (cond
+     ((and (boundp 'jit-lock-mode)
+	   (symbol-value 'jit-lock-mode))
+      (htmlize-with-fontify-message
+       (jit-lock-fontify-now (point-min) (point-max))))
+     ((and (boundp 'lazy-lock-mode)
+	   (symbol-value 'lazy-lock-mode))
+      (htmlize-with-fontify-message
+       (lazy-lock-fontify-region (point-min) (point-max))))
+     ((and (boundp 'lazy-shot-mode)
+	   (symbol-value 'lazy-shot-mode))
+      (htmlize-with-fontify-message
+       ;; lazy-shot is amazing in that it must *refontify* the region,
+       ;; even if the whole buffer has already been fontified.  
+       (lazy-shot-fontify-region (point-min) (point-max))))
+     ;; There's also fast-lock, but we don't need to handle specially,
+     ;; I think.  fast-lock doesn't really defer fontification, it
+     ;; just saves it to an external cache so it's not done twice.
+     )))
+
+
+;;;###autoload
+(defun htmlize-buffer (&optional buffer)
+  "Convert BUFFER to HTML, preserving colors and decorations.
+
+The generated HTML is available in a new buffer, which is returned.
+When invoked interactively, the new buffer is selected in the current
+window.  The title of the generated document will be set to the buffer's
+file name or, if that's not available, to the buffer's name.
+
+Note that htmlize doesn't fontify your buffers, it only uses the
+decorations that are already present.  If you don't set up font-lock or
+something else to fontify your buffers, the resulting HTML will be
+plain.  Likewise, if you don't like the choice of colors, fix the mode
+that created them, or simply alter the faces it uses."
+  (interactive)
+  (let ((htmlbuf (with-current-buffer (or buffer (current-buffer))
+		   (htmlize-buffer-1))))
+    (when (interactive-p)
+      (switch-to-buffer htmlbuf))
+    htmlbuf))
+
+;;;###autoload
+(defun htmlize-region (beg end)
+  "Convert the region to HTML, preserving colors and decorations.
+See `htmlize-buffer' for details."
+  (interactive "r")
+  ;; Don't let zmacs region highlighting end up in HTML.
+  (when (fboundp 'zmacs-deactivate-region)
+    (zmacs-deactivate-region))
+  (let ((htmlbuf (save-restriction
+		   (narrow-to-region beg end)
+		   (htmlize-buffer-1))))
+    (when (interactive-p)
+      (switch-to-buffer htmlbuf))
+    htmlbuf))
+
+(defun htmlize-region-for-paste (beg end)
+  "Htmlize the region and return just the HTML as a string.
+This forces the `inline-css' style and only returns the HTML body,
+but without the BODY tag.  This should make it useful for inserting
+the text to another HTML buffer."
+  (let* ((htmlize-output-type 'inline-css)
+	 (htmlbuf (htmlize-region beg end)))
+    (unwind-protect
+	(with-current-buffer htmlbuf
+	  (buffer-substring (plist-get htmlize-buffer-places 'content-start)
+			    (plist-get htmlize-buffer-places 'content-end)))
+      (kill-buffer htmlbuf))))
+
+(defun htmlize-make-file-name (file)
+  "Make an HTML file name from FILE.
+
+In its default implementation, this simply appends `.html' to FILE.
+This function is called by htmlize to create the buffer file name, and
+by `htmlize-file' to create the target file name.
+
+More elaborate transformations are conceivable, such as changing FILE's
+extension to `.html' (\"file.c\" -> \"file.html\").  If you want them,
+overload this function to do it and htmlize will comply."
+  (concat file ".html"))
+
+;; Older implementation of htmlize-make-file-name that changes FILE's
+;; extension to ".html".
+;(defun htmlize-make-file-name (file)
+;  (let ((extension (file-name-extension file))
+;	(sans-extension (file-name-sans-extension file)))
+;    (if (or (equal extension "html")
+;	    (equal extension "htm")
+;	    (equal sans-extension ""))
+;	(concat file ".html")
+;      (concat sans-extension ".html"))))
+
+;;;###autoload
+(defun htmlize-file (file &optional target)
+  "Load FILE, fontify it, convert it to HTML, and save the result.
+
+Contents of FILE are inserted into a temporary buffer, whose major mode
+is set with `normal-mode' as appropriate for the file type.  The buffer
+is subsequently fontified with `font-lock' and converted to HTML.  Note
+that, unlike `htmlize-buffer', this function explicitly turns on
+font-lock.  If a form of highlighting other than font-lock is desired,
+please use `htmlize-buffer' directly on buffers so highlighted.
+
+Buffers currently visiting FILE are unaffected by this function.  The
+function does not change current buffer or move the point.
+
+If TARGET is specified and names a directory, the resulting file will be
+saved there instead of to FILE's directory.  If TARGET is specified and
+does not name a directory, it will be used as output file name."
+  (interactive (list (read-file-name
+		      "HTML-ize file: "
+		      nil nil nil (and (buffer-file-name)
+				       (file-name-nondirectory
+					(buffer-file-name))))))
+  (let ((output-file (if (and target (not (file-directory-p target)))
+			 target
+		       (expand-file-name
+			(htmlize-make-file-name (file-name-nondirectory file))
+			(or target (file-name-directory file)))))
+	;; Try to prevent `find-file-noselect' from triggering
+	;; font-lock because we'll fontify explicitly below.
+	(font-lock-mode nil)
+	(font-lock-auto-fontify nil)
+	(global-font-lock-mode nil)
+	;; Ignore the size limit for the purposes of htmlization.
+	(font-lock-maximum-size nil)
+	;; Disable font-lock support modes.  This will only work in
+	;; more recent Emacs versions, so htmlize-buffer-1 still needs
+	;; to call htmlize-ensure-fontified.
+	(font-lock-support-mode nil))
+    (with-temp-buffer
+      ;; Insert FILE into the temporary buffer.
+      (insert-file-contents file)
+      ;; Set the file name so normal-mode and htmlize-buffer-1 pick it
+      ;; up.  Restore it afterwards so with-temp-buffer's kill-buffer
+      ;; doesn't complain about killing a modified buffer.
+      (let ((buffer-file-name file))
+	;; Set the major mode for the sake of font-lock.
+	(normal-mode)
+	(font-lock-mode 1)
+	(unless font-lock-mode
+	  ;; In GNU Emacs (font-lock-mode 1) doesn't force font-lock,
+	  ;; contrary to the documentation.  This seems to work.
+	  (font-lock-fontify-buffer))
+	;; htmlize the buffer and save the HTML.
+	(with-current-buffer (htmlize-buffer-1)
+	  (unwind-protect
+	      (progn
+		(run-hooks 'htmlize-file-hook)
+		(write-region (point-min) (point-max) output-file))
+	    (kill-buffer (current-buffer)))))))
+  ;; I haven't decided on a useful return value yet, so just return
+  ;; nil.
+  nil)
+
+;;;###autoload
+(defun htmlize-many-files (files &optional target-directory)
+  "Convert FILES to HTML and save the corresponding HTML versions.
+
+FILES should be a list of file names to convert.  This function calls
+`htmlize-file' on each file; see that function for details.  When
+invoked interactively, you are prompted for a list of files to convert,
+terminated with RET.
+
+If TARGET-DIRECTORY is specified, the HTML files will be saved to that
+directory.  Normally, each HTML file is saved to the directory of the
+corresponding source file."
+  (interactive
+   (list
+    (let (list file)
+      ;; Use empty string as DEFAULT because setting DEFAULT to nil
+      ;; defaults to the directory name, which is not what we want.
+      (while (not (equal (setq file (read-file-name
+				     "HTML-ize file (RET to finish): "
+				     (and list (file-name-directory
+						(car list)))
+				     "" t))
+			 ""))
+	(push file list))
+      (nreverse list))))
+  ;; Verify that TARGET-DIRECTORY is indeed a directory.  If it's a
+  ;; file, htmlize-file will use it as target, and that doesn't make
+  ;; sense.
+  (and target-directory
+       (not (file-directory-p target-directory))
+       (error "target-directory must name a directory: %s" target-directory))
+  (dolist (file files)
+    (htmlize-file file target-directory)))
+
+;;;###autoload
+(defun htmlize-many-files-dired (arg &optional target-directory)
+  "HTMLize dired-marked files."
+  (interactive "P")
+  (htmlize-many-files (dired-get-marked-files nil arg) target-directory))
+
+(provide 'htmlize)
+
+;;; htmlize.el ends here
diff --git a/elisp/emacs-goodies-el/initsplit.el b/elisp/emacs-goodies-el/initsplit.el
new file mode 100755
index 0000000..1787a41
--- /dev/null
+++ b/elisp/emacs-goodies-el/initsplit.el
@@ -0,0 +1,219 @@
+;;; initsplit --- code to split customizations into different files
+
+;; Copyright (C) 2000, 2001 John Wiegley
+
+;; Author: John Wiegley 
+;; Created:  8 Feb 2000
+;; Version: 1.6
+;; Keywords: lisp
+;; X-URL: http://www.gci-net.com/users/j/johnw/emacs.html
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with 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 file allows you to split Emacs customizations (set via M-x
+;; customize) into different files, based on the names of the
+;; variables.  It uses a regexp to match against each face and
+;; variable name, and associates with a file that the variable should
+;; be stored in.
+
+;; To use it, just load the file in your .emacs:
+;;
+;;   (load "initsplit")
+;;
+;; If you want configuration files byte-compiled, add this after it:
+;;
+;;   (add-hook 'after-save-hook 'initsplit-byte-compile-files t)
+
+;; Note that that you *must* load each file that contains your various
+;; customizations from your .emacs.  Otherwise, the variables won't
+;; all be set, and the next time you use the customize interface, it
+;; will delete the settings in those other files.
+
+;; Then, customize the variable `initsplit-customizations-alist', to
+;; associate various configuration names with their respective
+;; initialization files.
+
+;; I find this module most useful for splitting up Gnus and Viper
+;; customizations.
+
+;;; History:
+
+;;; Code:
+
+(defconst initsplit-version "1.6"
+  "This version of initsplit.")
+
+(defgroup initsplit nil
+  "Code to split customizations into different files."
+  :group 'initialization)
+
+;;; User Variables:
+
+(defcustom initsplit-load-hook nil
+  "*A hook that gets run after \"initsplit.el\" has been loaded."
+  :type 'hook
+  :group 'initsplit)
+
+(defcustom initsplit-customizations-alist nil
+  "*An alist that describes how to split up init file customizations."
+  :type '(repeat
+	  (list (regexp  :tag "Var regexp")
+		(file    :tag "Custom file")
+		(boolean :tag "Byte-compile")))
+  :group 'initsplit)
+
+(defcustom initsplit-sort-customizations
+  (and (boundp 'emacs-major-version)
+       (= emacs-major-version 20))
+  "*If non-nil, sort the arguments to `custom-set-variables'."
+  :type 'boolean
+  :group 'initsplit)
+
+;;; User Functions:
+
+(defun initsplit-narrow-to-custom (&optional faces)
+  (goto-char (point-min))
+  (let (pos)
+    (if (re-search-forward
+	 (format "^(custom-set-%s"
+		 (if faces "faces" "variables")) nil t)
+	(setq pos (match-beginning 0))
+      (goto-char (point-max))
+      (insert "\n")
+      (setq pos (point))
+      (insert (format "(custom-set-%s)"
+		      (if faces "faces" "variables"))) )
+    (goto-char pos))
+  (let ((beg (point)))
+    (forward-sexp)
+    (narrow-to-region beg (point)))
+  (goto-char (point-min))
+  (forward-line))
+
+(defun initsplit-delete-customizations (&optional faces)
+  "Delete all of the customization entries in a buffer."
+  (save-restriction
+    (initsplit-narrow-to-custom faces)
+    (forward-char -1)
+    (while (not (looking-at ")"))
+      (let ((opoint (point)))
+	(forward-sexp)
+	(delete-region opoint (point))))))
+
+(defun initsplit-sort-customizations (&optional faces)
+  "Sort the customization entries in a buffer."
+  (save-restriction
+    (initsplit-narrow-to-custom faces)
+    (sort-subr
+     nil
+     (function
+      (lambda ()
+	(if (looking-at ")")
+	    (goto-char (point-max))
+	  (forward-char))))
+     (function
+      (lambda ()
+	(backward-up-list 1)
+	(forward-sexp)))
+     (function
+      (lambda ()
+	(re-search-forward "'(\\(\\S-+\\)")
+	(match-string 1))))))
+
+(defvar initsplit-modified-buffers nil)
+
+(defun initsplit-split-customizations (&optional faces)
+  (save-restriction
+    (initsplit-narrow-to-custom faces)
+    (while (looking-at "^\\s-*\\(;;\\|'(\\(\\S-+\\)\\)")
+      (let ((var (match-string 2))
+	    (cal initsplit-customizations-alist)
+	    found)
+	(while (and var cal)
+	  (if (not (string-match (caar cal) var))
+	      (setq cal (cdr cal))
+	    (setq found t)
+	    (let ((opoint (point)))
+	      (forward-sexp)
+	      (kill-region opoint (point))
+	      (if (looking-at "^\\s-*)")
+		  (delete-indentation)
+		(delete-char 1)))
+	    (with-current-buffer
+		(find-file-noselect (nth 1 (car cal)))
+	      (unless (memq (current-buffer) initsplit-modified-buffers)
+		(setq initsplit-modified-buffers
+		      (cons (current-buffer) initsplit-modified-buffers))
+		(initsplit-delete-customizations)
+		(initsplit-delete-customizations t))
+	      (save-restriction
+		(initsplit-narrow-to-custom faces)
+		(forward-char -1)
+		(insert ?\n)
+		(yank)))
+	    (setq cal nil)))
+	(unless found
+	  (forward-sexp)
+	  (forward-line))))))
+
+(defun initsplit-split-user-init-file ()
+  (save-excursion
+    (if (string= (file-truename (buffer-file-name (current-buffer)))
+		 (file-truename (or custom-file user-init-file)))
+	(let (initsplit-modified-buffers)
+	  (initsplit-split-customizations)
+	  (initsplit-split-customizations t)
+	  (while initsplit-modified-buffers
+	    (with-current-buffer (car initsplit-modified-buffers)
+	      (when initsplit-sort-customizations
+		(initsplit-sort-customizations)
+		(initsplit-sort-customizations t))
+	      (save-buffer))
+	    (setq initsplit-modified-buffers
+		  (cdr initsplit-modified-buffers)))
+	  (when initsplit-sort-customizations
+	    (initsplit-sort-customizations)
+	    (initsplit-sort-customizations t))))
+    nil))
+
+(add-hook 'write-file-hooks 'initsplit-split-user-init-file t)
+
+(defun initsplit-byte-compile-files ()
+  (if (string= (file-truename (buffer-file-name (current-buffer)))
+	       (file-truename (or custom-file user-init-file)))
+      (byte-compile-file (file-truename
+			  (buffer-file-name (current-buffer))))
+    (let ((cal initsplit-customizations-alist))
+      (while cal
+	(if (and (nth 2 (car cal))
+		 (string= (file-truename (nth 1 (car cal)))
+			  (file-truename
+			   (buffer-file-name (current-buffer)))))
+	    (byte-compile-file (file-truename
+				(buffer-file-name (current-buffer)))))
+	(setq cal (cdr cal))))))
+
+;;(add-hook 'after-save-hook 'initsplit-byte-compile-files t)
+
+;;; Internal Functions:
+
+(provide 'initsplit)
+
+(run-hooks 'initsplit-load-hook)
+
+;;; initsplit.el ends here
diff --git a/elisp/emacs-goodies-el/joc-toggle-buffer.el b/elisp/emacs-goodies-el/joc-toggle-buffer.el
new file mode 100755
index 0000000..5a74c9a
--- /dev/null
+++ b/elisp/emacs-goodies-el/joc-toggle-buffer.el
@@ -0,0 +1,239 @@
+;;; @(#) toggle-buffer.el --- flips back and forth between two buffers
+
+;; Copyright (C) 2001 by Joseph L. Casadonte Jr.
+
+;; Author:          Joe Casadonte (emacs@northbound-train.com)
+;; Maintainer:      Joe Casadonte (emacs@northbound-train.com)
+;; Created:         January 26, 2001
+;; Keywords:        toggle buffer
+;; Latest Version:  http://www.northbound-train.com/emacs.html
+
+;; This file is not part of Emacs
+
+;; COPYRIGHT NOTICE
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+;;
+;;  This package provides a way to toggle back and forth between the
+;;  last two active buffers, without any extra keystrokes (like
+;;  accepting the default argument to `switch-to-buffer').
+
+;;; Nut & Bolts:
+;;
+;;  This package works by advising `switch-to-buffer', so if your
+;;  favorite buffer switching command does not ultimately call
+;;  `switch-to-buffer', this won't work.  Packages that alter the
+;;  current buffer *before* `switch-to-buffer' is called will also not
+;;  work properly.  Both of these situations may be salvagable with
+;;  the addition of more advice.  In the first case, just write a bit
+;;  of advice which essentially duplicates what I'm doing here with
+;;  `switch-to-buffer'.
+;;
+;;  I've provided a hack (and a "hook") to help with the second
+;;  situation.  The hack is to define a second variable (the "hook")
+;;  before the list is altered.  Once `switch-to-buffer' is called,
+;;  the advice provided in this package will first look for this
+;;  hook/hack variable and use its value; if that's not found, it will
+;;  use the value returned by `buffer-name'.
+;;
+;;  An example of this is the `swbuff' package, which changes the
+;;  current buffer before switching to the next one (though I'm not
+;;  sure why it does this).  Since I use swbuff, I've included its
+;;  hack along with this package.  You can customize whether or not
+;;  this hack is loaded (see Customization below).
+
+;;; Installation:
+;;
+;;  Put this file on your Emacs-Lisp load path and add the following to your
+;;  ~/.emacs startup file
+;;
+;;     (require 'toggle-buffer)
+
+;;; Usage:
+;;
+;;  M-x `joc-toggle-buffer'
+;;     Switched to the previous active buffer (when `switch-to-buffer' was
+;;     called).  If there is no previous buffer, or if the buffer no longer
+;;     exists, a message will be displayed in the minibuffer.
+
+;;; Customization:
+;;
+;;  M-x `joc-toggle-buffer-customize' to customize all package options.
+;;
+;;  The following variables can be customized:
+;;
+;;  o `joc-toggle-buffer-swbuff-advice'
+;;     A hack to be compatable with the swbuff package.
+;;
+;;     Valid values are:
+;;       o Never Advise - never advise the swbuff functions [nil]
+;;       o Advise if Provided - only advise if swbuff already provided [P]
+;;       o Always Advise - always define & activate the swbuff advise [A]
+;;
+;;     If you don't use the swbuff package, you can safely choose
+;;     Never Advise or Advise if Provided.  If you do use swbuff, you
+;;     may use Advise if Provided (in which case swbuff must be
+;;     `provide'd already) or Always Advise."
+
+;;; To Do:
+;;
+;;  o Nothing, at the moment.
+
+;;; Comments:
+;;
+;;  Any comments, suggestions, bug reports or upgrade requests are welcome.
+;;  Please send them to Joe Casadonte (emacs@northbound-train.com).
+;;
+;;  This version of toggle-buffer was developed and tested with NTEmacs 20.5.1
+;;  and 2.7 under Windows NT 4.0 SP6 and Emacs 20.7.1 under Linux (RH7).
+;;  Please, let me know if it works with other OS and versions of Emacs.
+
+;;; Change Log:
+;;
+;;  see http://www.northbound-train.com/emacs/toggle-buffer.log
+
+;;; **************************************************************************
+;;; **************************************************************************
+;;; **************************************************************************
+;;; **************************************************************************
+;;; **************************************************************************
+;;; Code:
+
+(eval-when-compile
+  (defvar byte-compile-dynamic nil) ; silence the old byte-compiler
+  (set (make-local-variable 'byte-compile-dynamic) t))
+
+;;; **************************************************************************
+;;; ***** customization routines
+;;; **************************************************************************
+(defgroup joc-toggle-buffer nil
+  "toggle-buffer package customization"
+  :group 'tools)
+
+;; ---------------------------------------------------------------------------
+(defun joc-toggle-buffer-customize ()
+  "Customization of the group `joc-toggle-buffer'."
+  (interactive)
+  (customize-group "joc-toggle-buffer"))
+
+;; ---------------------------------------------------------------------------
+(defcustom joc-toggle-buffer-swbuff-advice "P"
+  "A hack to be compatable with the swbuff package.
+
+Valid values are:
+  o Never Advise - never advise the swbuff functions [nil]
+  o Advise if Provided - only advise if swbuff already provided [P]
+  o Always Advise - always define & activate the swbuff advise [A]
+
+If you don't use the swbuff package, you can safely choose
+Never Advise or Advise if Provided.  If you do use swbuff, you
+may use Advise if Provided (in which case swbuff must be
+`provide'd already) or Always Advise."
+  :type `(choice
+	  (const :tag "Never Advise" nil)
+	  (const :tag "Advise if Provided" "P")
+	  (const :tag "Always Advise" "A"))
+  :group 'joc-toggle-buffer)
+
+;; ---------------------------------------------------------------------------
+(defcustom toggle-buffer-load-hook nil
+  "Hook to run when package is loaded."
+  :type 'hook
+  :group 'joc-toggle-buffer)
+
+;;; **************************************************************************
+;;; ***** version related routines
+;;; **************************************************************************
+(defconst joc-toggle-buffer-version
+  "$Revision: 1.2 $"
+  "Version number for toggle-buffer package.")
+
+;; ---------------------------------------------------------------------------
+(defun joc-toggle-buffer-version-number ()
+  "Return `toggle-buffer' version number."
+  (string-match "[0123456789.]+" joc-toggle-buffer-version)
+  (match-string 0 joc-toggle-buffer-version))
+
+;; ---------------------------------------------------------------------------
+(defun joc-toggle-buffer-display-version ()
+  "Display `toggle-buffer' version."
+  (interactive)
+  (message "toggle-buffer version <%s>." (joc-toggle-buffer-version-number)))
+
+;;; **************************************************************************
+;;; ***** interactive functions
+;;; **************************************************************************
+(defvar joc-toggle-buffer-last-buffer nil
+  "Contains the name of the previous buffer.")
+
+(defun joc-toggle-buffer ()
+  "Switch to previous active buffer."
+  (interactive)
+  (if (not (boundp 'joc-toggle-buffer-last-buffer))
+	  (error "No previous buffer to switch to (yet)"))
+  (let ((buff (get-buffer joc-toggle-buffer-last-buffer)))
+	(if (not buff)
+		(error "Invalid buffer \"%s\"" joc-toggle-buffer-last-buffer)
+	  (switch-to-buffer buff))))
+
+;;; **************************************************************************
+;;; ***** normal advice
+;;; **************************************************************************
+(defadvice switch-to-buffer
+  (before joc-toggle-buffer-setup-advice act)
+  "Records active buffer (for possible later recall) before it's switched."
+  (if (boundp 'joc-toggle-buffer-hack)
+	  (setq joc-toggle-buffer-last-buffer joc-toggle-buffer-hack)
+	(setq joc-toggle-buffer-last-buffer (buffer-name))))
+
+;;; **************************************************************************
+;;; ***** swbuff-specific advice
+;;; **************************************************************************
+(let ((advise-swbuff-fns nil))
+  (if joc-toggle-buffer-swbuff-advice
+	  (if (eq joc-toggle-buffer-swbuff-advice "P")
+		  (if (featurep 'swbuff)
+			  (setq advise-swbuff-fns t))
+		(setq advise-swbuff-fns t)))
+
+  (if advise-swbuff-fns
+	  (progn
+		(defadvice swbuff-switch-to-next-buffer
+		  (around joc-toggle-buffer-swbuf-next-advice act)
+		  "hack for swbuff-users"
+		  (setq joc-toggle-buffer-hack (buffer-name))
+		  ad-do-it
+		  (makunbound 'joc-toggle-buffer-hack))
+
+		(defadvice swbuff-switch-to-previous-buffer
+		  (around joc-toggle-buffer-swbuf-prev-advice act)
+		  "hack for swbuff-users"
+		  (setq joc-toggle-buffer-hack (buffer-name))
+		  ad-do-it
+		  (makunbound 'joc-toggle-buffer-hack))
+		)))
+
+;;; **************************************************************************
+;;; ***** we're done
+;;; **************************************************************************
+(provide 'toggle-buffer)
+(run-hooks 'toggle-buffer-load-hook)
+
+;;; toggle-buffer.el ends here
+;;; **************************************************************************
+;;;; *****  EOF  *****  EOF  *****  EOF  *****  EOF  *****  EOF  *************
diff --git a/elisp/emacs-goodies-el/joc-toggle-case.el b/elisp/emacs-goodies-el/joc-toggle-case.el
new file mode 100755
index 0000000..6318692
--- /dev/null
+++ b/elisp/emacs-goodies-el/joc-toggle-case.el
@@ -0,0 +1,317 @@
+;;; **************************************************************************
+;; @(#) toggle-case.el -- toggles case at poitn like ~ in vi
+
+;; This file is not part of Emacs
+
+;; Copyright (C) 2001 by Joseph L. Casadonte Jr.
+;; Author:          Joe Casadonte (emacs@northbound-train.com)
+;; Maintainer:      Joe Casadonte (emacs@northbound-train.com)
+;; Created:         January 03, 2001
+;; Latest Version:  http://www.northbound-train.com/emacs.html
+;; @(#) $Id: joc-toggle-case.el,v 1.3 2013/12/04 22:32:10 psg Exp $
+
+;; COPYRIGHT NOTICE
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+;;; **************************************************************************
+
+;;; Description:
+;;
+;;  This packages provides a sophisticated (over-engineered?) set of
+;;  functions to toggle the case of the character under point, with
+;;  which you can emulate vi's ~ function, which I found useful and
+;;  miss.  Basically, the vi command (and my version of it) toggles
+;;  the case of the current character and then advances to the next
+;;  character, allowing successive invocations to progress down the
+;;  line.
+
+;;; Installation:
+;;
+;;  Put this file on your Emacs-Lisp load path and add the following to your
+;;  ~/.emacs startup file
+;;
+;;     (require 'toggle-case)
+;;
+;;  See below for key-binding suggestions.
+
+;;; Usage:
+;;
+;;  M-x `joc-toggle-case'
+;;     Toggles the case of the character under point.  If called with
+;;     a prefix argument, it toggles that many characters (see
+;;     joc-toggle-case-stop-at-eol).  If the prefix is negative, the
+;;     case of the character before point is toggled, and if called
+;;     with a prefix argument, N characters before point will have
+;;     their case toggled (see also joc-toggle-case-backwards).
+;;
+;;  M-x `joc-toggle-case-backwards'
+;;     Convenience function to toggle case of character preceeding
+;;     point.  This is the same as calling joc-toggle-case with a
+;;     negative prefix (and is in fact implemented that way).
+;;
+;;  M-x `joc-toggle-case-by-word'
+;;     Similar to joc-toggle-case except that the count (supplied by
+;;     the prefix argument) is of the number of words, not letters, to
+;;     be toggled.  It will start from point and move to the end of
+;;     the first word at a minimum, and then take whole words from
+;;     there.  If called with a negative prefix, then from point to
+;;     beginning of current word will have their case toggled, going
+;;     backwards for N words (see also
+;;     joc-toggle-case-by-word-backwards).  Note that the
+;;     joc-toggle-case-stop-at-eol setting will be honored.
+;;
+;;  M-x `joc-toggle-case-by-word-backwards'
+;;     Convenience function to toggle case by word, backwards.  This
+;;     is the same as calling joc-toggle-case-by-word with a
+;;     negative prefix (and is in fact implemented that way).
+;;
+;;  M-x `joc-toggle-case-by-word-backwards'
+;;     Toggles the case of all characters in the current region.
+
+;;; Customization:
+;;
+;;  M-x `joc-toggle-case-customize' to customize all package options.
+;;
+;;  The following variables can be customized:
+;;
+;;  o `joc-toggle-case-stop-at-eol'
+;;        Boolean used to determine whether or not the toggle
+;;        advancement stops at the end of a line.  Set to `t' it will
+;;        stop at the end of the line, set to `nil' it will not (it
+;;        will continue on to the next line).  If direction of toggle
+;;        is reversed, the semantics of this are reveresed as well
+;;        (i.e. does it stop at the beginning of the line).
+
+;;; Keybinding examples:
+;;
+;;  This is what I have -- use it or not as you like.
+;;
+;;       (global-set-key [(control \`)] 'joc-toggle-case)
+;;       (global-set-key [(control ~)] 'joc-toggle-case-backwards)
+;;
+;;       (global-set-key [(control meta \`)] 'joc-toggle-case-by-word)
+;;       (global-set-key [(control meta ~)] 'joc-toggle-case-by-word-backwards)
+;;
+;;       (define-key joc-F3-keymap [(\`)] 'joc-toggle-case-by-region)
+;;
+;;   I have a special F3 keymap which this last one is bound to.
+;;   Email me if you'd like more details.
+
+;;; To Do:
+;;
+;;  o Nothing, at the moment.
+
+;;; Comments:
+;;
+;;  Any comments, suggestions, bug reports or upgrade requests are welcome.
+;;  Please send them to Joe Casadonte (emacs@northbound-train.com).
+;;
+;;  This version of toggle-case was developed and tested with NTEmacs
+;;  2.7 under Windows NT 4.0 SP6 and Emacs 20.7.1 under Linux (RH7).
+;;  Please, let me know if it works with other OS and versions of Emacs.
+
+;;; **************************************************************************
+;;; **************************************************************************
+;;; **************************************************************************
+;;; **************************************************************************
+;;; **************************************************************************
+;;; Code:
+
+;;; **************************************************************************
+;;; ***** customization routines
+;;; **************************************************************************
+(defgroup joc-toggle-case nil
+  "joc-toggle-case package customization"
+  :group 'tools)
+
+;; ---------------------------------------------------------------------------
+(defun joc-toggle-case-customize ()
+  "Customization of the group joc-toggle-case."
+  (interactive)
+  (customize-group "joc-toggle-case"))
+
+;; ---------------------------------------------------------------------------
+(defcustom joc-toggle-case-stop-at-eol nil
+  "Boolean used to determine whether or not the toggle
+advancement stops at the end of a line.  Set to `t' it will
+stop at the end of the line, set to `nil' it will not (it
+will continue on to the next line).  If direction of toggle
+is reversed, the semantics of this are reveresed as well
+(i.e. does it stop at the beginning of the line)."
+  :group 'joc-toggle-case
+  :type 'boolean)
+
+;;; **************************************************************************
+;;; ***** version related routines
+;;; **************************************************************************
+(defconst joc-toggle-case-version
+  "$Revision: 1.3 $"
+  "joc-toggle-case version number.")
+
+;; ---------------------------------------------------------------------------
+(defun joc-toggle-case-version-number ()
+  "Returns joc-toggle-case version number."
+  (string-match "[0123456789.]+" joc-toggle-case-version)
+  (match-string 0 joc-toggle-case-version))
+
+;; ---------------------------------------------------------------------------
+(defun joc-toggle-case-display-version ()
+  "Displays joc-toggle-case version."
+  (interactive)
+  (message "joc-toggle-case version <%s>." (joc-toggle-case-version-number)))
+
+;;; **************************************************************************
+;;; ***** interactive functions
+;;; **************************************************************************
+(defun joc-toggle-case (prefix)
+  "Toggles the case of the character under point.  If called with
+a prefix argument, it toggles that many characters (see
+joc-toggle-case-stop-at-eol).  If the prefix is negative, the
+case of the character before point is toggled, and if called
+with a prefix argument, N characters before point will have
+their case toggled (see also joc-toggle-case-backwards)."
+
+  (interactive "*p")
+
+  ;; loop thru N times
+  (let ((forward-flag (> prefix 0))
+		(count (abs prefix))
+		(lcv 0))
+	(while (< lcv count)
+	  (joc-internal-toggle-case forward-flag)
+	  (setq lcv (1+ lcv))
+
+	  ;; make sure we're not at [be]ol
+	  (if (and joc-toggle-case-stop-at-eol
+			   (or (and forward-flag (eolp))
+				   (and (not forward-flag) (bolp))))
+		  ;; set it high to exit
+		  (setq lcv count))
+
+	  ;; make sure we're not at the [be]ob
+	  (if (or (bobp) (eobp))
+		  ;; set it high to exit
+		  (setq lcv count)))))
+
+;; ---------------------------------------------------------------------------
+(defun joc-toggle-case-backwards (prefix)
+  "Convenience function to toggle case of character preceeding
+point.  This is the same as calling joc-toggle-case with a
+negative prefix (and is in fact implemented that way)."
+  (interactive "*p")
+  (joc-toggle-case (- prefix)))
+
+;; ---------------------------------------------------------------------------
+(defun joc-toggle-case-by-word (prefix)
+  "Similar to joc-toggle-case except that the count (supplied by
+the prefix argument) is of the number of words, not letters, to
+be toggled.  It will start from point and move to the end of
+the first word at a minimum, and then take whole words from
+there.  If called with a negative prefix, then from point to
+beginning of current word will have their case toggled, going
+backwards for N words (see also
+joc-toggle-case-by-word-backwards).  Note that the
+joc-toggle-case-stop-at-eol setting will be honored."
+
+  (interactive "*p")
+
+  ;; just look n words out, leave it to the lower level
+  ;; functions to determine if a boundary's been reached
+  (let ((start (point)) (end))
+	(save-excursion
+	  ;; this leaves us at the end (or beginning) of the word
+	  (forward-word prefix)
+	  (setq end (point)))
+	(joc-toggle-case (- end start))))
+
+;; ---------------------------------------------------------------------------
+(defun joc-toggle-case-by-word-backwards (prefix)
+  "Convenience function to toggle case by word, backwards.  This
+is the same as calling joc-toggle-case-by-word with a
+negative prefix (and is in fact implemented that way)."
+  (interactive "*p")
+  (joc-toggle-case-by-word (- prefix)))
+
+;; ---------------------------------------------------------------------------
+(defun joc-toggle-case-by-region (start end)
+  "Toggles the case of all characters in the current region."
+  (interactive "*r")
+  (save-excursion
+	(let ((deactivate-mark nil))
+	  (goto-char start)
+	  (joc-toggle-case (- end start))
+	  (forward-char 2))))
+
+;;; **************************************************************************
+;;; ***** non-interactive functions
+;;; **************************************************************************
+(defun joc-internal-toggle-case (forward-flag)
+  "Internal workhorse for joc-toggle-case functions."
+
+  (let ((backward-flag (not forward-flag)))
+	;; if we're to stop at [be]ol and we're already there, check that first
+	(if (and joc-toggle-case-stop-at-eol
+			 (or (and backward-flag (bolp))
+				 (and forward-flag (eolp))))
+		;; note an error
+		(ding)
+
+	  ;; backup first if going backward, as we always delete forward
+	  (if backward-flag
+		  (backward-char))
+
+	  ;; actually delete and replace the character
+	  (let ((c (following-char)))
+		(if (eq c (upcase c))
+			(insert-char (downcase c) 1 t)
+		  (insert-char (upcase c) 1 t))
+		(delete-char 1 nil)
+
+		;; again, backup if we're backing up
+		(if backward-flag
+			(backward-char))
+
+		;; point is where it's supposed to be unless at [be]ol
+		;; maybe move point to next position
+
+		;; stop && backwards && BOL
+		(if (and joc-toggle-case-stop-at-eol
+				 backward-flag
+				 (bolp))
+			;; warn the user
+			(ding)
+		  ;; stop && forwards && EOL
+		  (if (and joc-toggle-case-stop-at-eol
+				   forward-flag
+				   (eolp))
+			  ;; warn the user
+			  (ding)
+			;; no-stop && backwards && BOL
+			(if (and backward-flag (bolp))
+				(backward-char 1)
+			  ;; no-stop && forwards && EOL
+			  (if (and forward-flag (eolp))
+				  (forward-char 1)))))
+		))))
+
+;;; **************************************************************************
+;;; ***** we're done
+;;; **************************************************************************
+(provide 'toggle-case)
+
+;; toggle-case.el ends here!
+;;; **************************************************************************
+;;;; *****  EOF  *****  EOF  *****  EOF  *****  EOF  *****  EOF  *************
diff --git a/elisp/emacs-goodies-el/keydef.el b/elisp/emacs-goodies-el/keydef.el
new file mode 100755
index 0000000..7ea0edd
--- /dev/null
+++ b/elisp/emacs-goodies-el/keydef.el
@@ -0,0 +1,395 @@
+;;; keydef.el --- a simpler way to define keys, with kbd syntax
+
+;; Emacs Lisp Archive Entry
+;; Filename: keydef.el
+;; Author: Michael John Downes 
+;; Created: 2001/01/18
+;; Keywords: convenience lisp customization keyboard keys
+;; Version: 1.16
+;; $Revision: 1.1.1.1 $ $Date: 2003-04-04 20:16:06 $
+
+;; This program was placed in the public domain on 2001/01/18 by the
+;; Author. The 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.
+
+;;; Commentary:
+
+;;; The macro keydef provides a simplified interface to define-key that
+;;; smoothly handles a number of common complications.
+
+;;; The global-set-key command isn't ideal for novices because of its
+;;; relatively complex syntax. And I always found it a little
+;;; inconvenient to have to quote the name of the command---that is, I
+;;; tend to forget the quote every once in a while and then have to go
+;;; back and fix it after getting a load error.
+
+;;; One of the best features is that you can give an Emacs lisp form (or
+;;; even a series of forms) as the key definition argument, instead of a
+;;; command name, and the keydef macro will automatically add an
+;;; interactive lambda wrapper. I use this to get, for example, a more
+;;; emphatic kill-buffer command (no confirmation query) by writing
+;;;
+;;;   (keydef "" (kill-buffer nil))
+;;;
+;;; For keydef the key sequence is expected to be given uniformly in the
+;;; form of a string for the 'kbd' macro, with one or two refinements
+;;; that are intended to conceal from users certain points of confusion,
+;;; such as (for those whose keyboards lack a Meta key) the whole
+;;; Meta/ESC/escape muddle.
+
+;;; I have had some trouble in the past regarding the distinction
+;;; between ESC and [escape] (in a certain combination of circumstances
+;;; using the latter form caused definitions made with the other form to
+;;; be masked---most puzzling when I wasn't expecting it). Therefore the
+;;; ESC form is actually preprocessed a bit to ensure that the binding
+;;; goes into esc-map.
+
+;;; There is one other special feature of the key sequence syntax
+;;; expected by the keydef macro: You can designate a key definition for
+;;; a particular mode-map by giving the name of the mode together with
+;;; the key sequence string in list form, for example
+;;;
+;;;   (keydef (latex "C-c %") comment-region)
+;;;
+;;; This means that the key will be defined in latex-mode-map. [The
+;;; point of using this particular example will be made clear below.] I
+;;; arranged for the mode name to be given in symbol form just because I
+;;; didn't want to have to type extra quotes if I could get away with
+;;; it. For the same reason this kind of first arg is not written in
+;;; dotted pair form.
+
+;;; If the given mode-map is not defined, keydef "does the right thing"
+;;; using eval-after-load. In order to determine what library the
+;;; mode-map will be loaded from, it uses the following algorithm:
+;;;
+;;; First check if foo-mode has autoload information. If not, check
+;;; whether "foo-mode" is the name of a library that can be found
+;;; somewhere in the load-path (using locate-library); otherwise check
+;;; whether "foo" is the name of a locatable library. Failing that, give
+;;; up and return nil.
+;;;
+;;; There is a fall-back mechanism, however, to handle exceptional
+;;; cases. If foo-mode-map is undefined but the list mode-map-alist
+;;; contains an entry of the form (foo-mode-map foo-other-name-map),
+;;; then foo-other-name-map is used as the name of the
+;;; keymap.
+;;;
+;;; If the mode-map is not loaded yet AND the command being bound to a
+;;; key is undefined at the time of the keydef assignment, it presents
+;;; further problems. The simplest solution is to assume that after the
+;;; package is loaded that defines the mode-map, the given command will
+;;; be defined and satisfy commandp. With some extra effort it should be
+;;; possible to determine more accurately whether the command will be
+;;; defined or not, but I'm not sure I want to go to that extreme, since
+;;; as far as I can see it would require opening the package file and
+;;; searching through it for a matching defun/defalias/fset statement.
+;;;
+;;; If the mode name matches the mode map name, but foo-mode is not
+;;; autoloaded, then some autoload information may need to be provided.
+;;; For example, the following line allows definitions to be made for
+;;; debugger-mode-map even before debug.el is loaded.
+;;;
+;;;  (autoload 'debugger-mode "debug" "Autoloaded." 'interactive)
+;;;
+;;; Although there is no easy way provided by keydef for
+;;; gnus-summary-limit-map to be accessed directly, because
+;;; its name does not include "mode", you can get a binding into
+;;; such a map by writing
+;;;
+;;;   (keydef (gnus-summary "/ z") gnus-summary-limit-to-zapped)
+;;;
+;;; which binds /z in gnus-summary-mode-map, which is equivalent to
+;;; binding z in gnus-summary-limit-map.
+;;;
+;;; You might need to add an autoload statement for gnus-summary-mode
+;;; in order for this to work, so that keydef knows that it should use
+;;; eval-after-load and that the file the mode function will be loaded
+;;; from is called "gnus-sum" rather than "gnus-summary-mode". (If it
+;;; were the latter, keydef would be able to resolve everything
+;;; automatically.)
+
+;;; We COULD HAVE just put the definitions into the mode hook in the
+;;; standard way, instead of using eval-after-load, but that would mean
+;;; the key definitions get executed repetitiously every time the mode
+;;; function gets called, which seems better to avoid, if only for
+;;; esthetic reasons (if it can be done without too much trouble).
+
+;;; The following examples show some typical keydef lines followed by the
+;;; results of the macro expansion.
+
+;;; Simplest kind of definition:
+;;;
+;;; (keydef "C-x m" gnus-group-mail)
+;;;
+;;;   -->(define-key global-map (kbd "C-x m") (quote gnus-group-mail))
+
+;;; What if the command name is misspelled?
+;;;
+;;; (keydef "C-x m" gnus-gruop-mail)
+;;;
+;;;   -->(message "keydef: gnus-gruop-mail unknown \
+;;;                \(perhaps misspelled, or not loaded yet\)")
+
+;;; A leading ESC gets special handling to go through esc-map.
+;;;
+;;; (keydef "ESC &" query-replace-regexp)
+;;;
+;;;   -->(define-key esc-map (kbd "&") (quote query-replace-regexp))
+
+;;; Undefine a key:
+;;;
+;;; (keydef "ESC `")
+;;;
+;;;   -->(define-key esc-map (kbd "`") nil)
+
+;;; If the second arg is a string, keydef defines the given key sequence
+;;; as a keyboard macro. The following macro puts in TeX-style double
+;;; quotes and then moves the cursor backward to leave it in the middle:
+;;;
+;;; (keydef "\"" "``''\C-b\C-b")
+;;;
+;;;   -->(define-key global-map (kbd "\"") "``''\002\002")
+
+;;; Reset a key to self-insert
+;;;
+;;; (keydef "\"" "\"")
+;;;
+;;;   -->(define-key global-map (kbd "\"") (quote self-insert-command))
+
+;;; If the second arg is a list, wrap it in an interactive lambda form.
+;;;
+;;; (keydef "C-z"
+;;;   (message "Control-Z key disabled---redefine it if desired."))
+;;;
+;;;   -->(define-key global-map
+;;;       (kbd "C-z")
+;;;       (lambda (arg)
+;;;         "anonymous keydef function"
+;;;         (interactive "p")
+;;;         (message "Control-Z key disabled---redefine it if desired.")))
+;;;
+;;; Note that the interactive lambda wrapper added by keydef, when the
+;;; CMD does not satisfy commandp, always takes a single prefix argument
+;;; named "arg", which is read in the usual way with (interactive "p");
+;;; so this could be used in the body of the function if need be.
+
+;;; This shows the notation for F-keys.
+;;;
+;;; (keydef "" (kill-buffer nil))
+;;;
+;;;   -->(define-key global-map
+;;;       (kbd "")
+;;;       (lambda (arg)
+;;;         "*Anonymous function created by keydef."
+;;;         (interactive "p")
+;;;         (kill-buffer nil)))
+
+;;; Because of the confusing Meta/Escape complications, I recommend to
+;;; the users that I support that they use the ESC notation
+;;; consistently if that is what they type from their keyboard, even
+;;; for F-key definitions that might normally be written with 
+;;; notation.
+;;;
+;;; (keydef "ESC " find-file-read-only)
+;;;
+;;;   -->(define-key esc-map (kbd "") (quote find-file-read-only))
+
+;;; The next two definitions go together. The second one shows how to
+;;; write a mode-specific definition.
+;;;
+;;; (keydef "" isearch-forward)
+;;;
+;;;   -->(define-key global-map (kbd "") (quote isearch-forward))
+;;;
+;;; (keydef (isearch "") isearch-repeat-forward)
+;;;
+;;;   -->(define-key isearch-mode-map (kbd "")
+;;;                                   (quote isearch-repeat-forward))
+
+;;; Making a definition for a mode-map that is not loaded yet.
+;;;
+;;; (keydef (latex "C-c %") comment-region)
+;;;
+;;;   -->(eval-after-load "tex-mode"
+;;;        (quote
+;;;         (define-key latex-mode-map
+;;;           (kbd "C-c %")
+;;;           (quote comment-region))))
+
+;;; Code:
+
+;;; TO DO:
+;;;
+;;; ---If someone wants to do massive alterations or additions to a
+;;; mode-map that is not yet loaded, it might be a good idea to
+;;; provide another macro that will bundle them into a single
+;;; eval-after-load call rather than dozens of separate ones.
+;;;
+;;; ---More error-checking would probably be a good idea, when SEQ
+;;; satisfies listp but the contents of the list are not usable in the
+;;; way that we expect.
+
+;; This variable is needed because the information is not readily
+;; available for look-up in any other way. (Well, I don't want to get
+;; into defadvice'ing use-local-map and stuff like that.)
+(defvar mode-map-alist
+  (list
+   (quote (latex-mode tex-mode-map))
+   (quote (shell-script-mode sh-mode-map)))
+  "If the local keymap for foo-mode is bar-mode-map instead of
+foo-mode-map, this alist allows you to specify what corresponds to
+what. The car of each pair should be a major mode name and the cdr
+should be the name of the local map that is used for that mode.")
+
+;;; If the mode name matches the mode map name, but foo-mode is not
+;;; autoloaded, then some autoload information may need to be provided.
+;;; For example, the following line allows definitions to be made for
+;;; debugger-mode-map even before debug.el is loaded. This line would
+;;; not be necessary if debugger-mode were already declared as an
+;;; autoloaded function.
+(autoload 'debugger-mode "debug" "Autoloaded." 'interactive)
+
+(defun keydef-lib-lookup (mode)
+  "For a not-already-loaded mode function, try to determine what library
+it would be loaded from: First check for autoload information, otherwise
+check if a library file matching the mode name can be found in the load
+path, with or without the -mode suffix. Failing that, give up."
+  (let* ((modesym (intern mode))
+         (fcar (and (fboundp modesym) (car (symbol-function modesym)))))
+    (cond
+     ((eq fcar 'autoload)
+      (car (cdr (symbol-function modesym))))
+     ((locate-library mode)
+      mode)
+     (t
+      (let ((shortmode (substring mode 0 -5))) ; chop "-mode" from the end
+        (if (locate-library shortmode)
+            shortmode))))))
+
+;;;###autoload
+(defmacro keydef (seq &rest cmd)
+  "Define the key sequence SEQ, written in kbd form, to run CMD.
+CMD is automatically wrapped in an anonymous interactive function if it
+is Emacs Lisp code rather than a command name. SEQ may also have the form
+\(MODE SEQ\) where the car is a mode name\; for example
+
+  \(keydef \(latex \"C-c %\"\) comment-region\)
+
+means to define the given key in latex-mode-map. And this will work even
+if latex-mode is not loaded yet, provided that it is possible to deduce
+the file that it will be loaded from, either from the autoload info or
+by searching for a matching file name in the Emacs load path.
+
+For best results, the \"mode name\" that you use here should yield the
+proper foo-mode-map symbol when \"-mode-map\" is appended\; although
+this will normally match the mode name as given in the mode line,
+Shell-script is one example I can think of where it doesn't---the map is
+named sh-mode-map. The common cases that I know about, including
+shell-script-mode and latex-mode, are handled as exceptions through the
+variable mode-map-alist. But for other cases you will need to look up
+the name of the mode-map that goes with the given mode."
+  (let ((map (quote global-map))
+        (modestring)
+        (loaded t))
+    ;; If seq is a list, the car indicates a mode-specific map that we
+    ;; should use instead of global-map.
+    (if (and (listp seq)
+             (symbolp (car seq))
+             (stringp (car (cdr seq))))
+        (let ((othermap))
+          (setq modestring
+                (format "%s-mode"
+                        (downcase (symbol-name (car seq)))))
+          (setq othermap (assq (intern modestring) mode-map-alist))
+          (if othermap
+              (setq map (nth 1 othermap))
+            (setq map (intern (format "%s-map" modestring))))
+          (if (not (and (boundp map) (keymapp (symbol-value map))))
+              (setq loaded nil))
+          (setq seq (car (cdr seq)))))
+    (cond
+     ((stringp seq)
+      (if (string-match "^ESC " seq)
+          (progn
+            (setq seq (substring seq 4))
+            (setq map (quote esc-map)))))
+     (t
+      (if (vectorp seq)
+          (error
+"keydef: '%s' vector form disallowed here, use kbd syntax instead."
+           (prin1-to-string seq))
+        (error "keydef: Invalid key sequence '%s'" (prin1-to-string seq)))))
+    (if (not (null cmd))
+        (let ((token (car cmd)))
+          ;; Note that commandp is true for strings. So we have to be a
+          ;; little careful about the order of tests here.
+          (cond
+           ;; This case arises when an explicit second arg of nil is given.
+           ((eq token nil)
+            (setq cmd nil))
+           ;; If someone forgets that keydef does not require you to
+           ;; quote the command name, we had better make sure it works
+           ;; anyway.
+           ((eq (car-safe token) 'quote)
+            (setq cmd token))
+           ;; If the CMD is a one-character string that matches the SEQ, use
+           ;; self-insert-command as the binding. Otherwise it will be a macro
+           ;; that will run an infinite loop until specpdl-size is exceeded.
+           ((stringp token)
+            (if (and (= (length token) 1)
+                     (string-equal token seq))
+                (setq cmd '(quote self-insert-command))
+              (setq cmd token)))        ; kbd macro string
+           ;; If the command is a simple command name---or a keymap,
+           ;; such as help-command---use it directly as the
+           ;; definition.
+           ((and (or (commandp token) (keymapp token))
+                 (= (length cmd) 1))
+            (setq cmd `(quote ,token)))
+           ;; If the command looks like a simple command name but fails the
+           ;; commandp test, then probably it was misspelled; if it passes the
+           ;; fboundp test, however, make a lambda wrapper similar to the next
+           ;; case. Could try to work harder at getting the arguments right in
+           ;; that case, but for now just assume it has zero args.
+           ((and (= (length cmd) 1) (symbolp token))
+            (cond
+             ((fboundp token)
+              (setq cmd
+                    (append
+                     '(lambda (arg) "*Anonymous function created by keydef."
+                        (interactive "p"))
+                     (list cmd))))
+             ((not loaded)
+              ;; If the mode-map is not loaded yet, assume that the
+              ;; command will become defined when the package is loaded.
+              (setq cmd `(quote ,token)))
+             (t
+              ;; Unknown command is being added to a known map. Probably
+              ;; misspelled?
+              (setq cmd `(quote ,token))
+              (message
+               "keydef: '%s' unknown %s"
+               (prin1-to-string token)
+               "\(perhaps misspelled, or needs autoload info?\)"))))
+           (t
+            ;; We have what seems to be a list of code elements. Create
+            ;; an anonymous function wrapper.
+            (setq cmd
+                  (append
+                   '(lambda (arg)
+                      "*Anonymous function created by keydef."
+                      (interactive "p"))
+                   cmd))))))
+    (if (and (not loaded) modestring)
+        (let ((loadfrom (keydef-lib-lookup modestring)))
+          (if loadfrom
+              `(eval-after-load ,loadfrom
+                 (quote (define-key ,map (kbd ,seq) ,cmd)))
+            (message "keydef: '%s' unknown %s"
+                     modestring
+                     "\(perhaps misspelled, or needs autoload info?\)")))
+      `(define-key ,map (kbd ,seq) ,cmd))))
+
+(provide 'keydef)
+;;; keydef.el ends here
diff --git a/elisp/emacs-goodies-el/keywiz.el b/elisp/emacs-goodies-el/keywiz.el
new file mode 100755
index 0000000..8b093a1
--- /dev/null
+++ b/elisp/emacs-goodies-el/keywiz.el
@@ -0,0 +1,323 @@
+;;; keywiz.el --- Emacs key sequence quiz
+
+;; Copyright (C) 2002, 2003 Jesper Harder
+
+;; Author: Jesper Harder 
+;; Created: 15 Apr 2002
+;; Version: 1.4
+;; Location: 
+;; Keywords: games, keyboard
+
+;; 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:
+
+;; keywiz.el drills you about Emacs key-bindings.  You're presented
+;; with the name of a command and the docstring, and then prompted for
+;; the correct key sequence.  You'll earn one point for each correct
+;; answer during the time limit.
+;;
+;; Invoke with `M-x keywiz'.  A prefix argument will force keywiz to
+;; rescan the key-binding -- this is useful if you want to include
+;; bindings from a different mode.
+;;
+;; Are you a true Emacs key-binding wizard or just a poor vi looser?
+;; Get your foot-pedals in position and see how many key-bindings you
+;; can remember in two minutes.
+;;
+;; Forget about your Nethack high-score -- surely, knowing how to
+;; wield the powers of the One True Editor at your fingertips will
+;; earn you more bragging rights than ascending bare-footed in some
+;; silly game with vi-keybindings :-)
+
+;;; History:
+
+;; Changes in version 1.4:
+;;
+;; * Copy the current local and global keymap to the keywiz buffer.
+;; * Exclude `undefined'.
+;;
+;; Changes in version 1.3:
+;;
+;; Don't require cl at run-time.  Doc and customize fixes.  Exclude
+;; `select-window'.
+;;
+;; Changes in version 1.2:
+;; Patch from  Luke Gorrie :
+;;
+;; * Cache key-bindings to make start up faster.
+;;
+;; * Pressing `r' will pause keywiz and enter a recursive edit in the
+;;   *scratch* buffer.
+;;
+;; Changes in version 1.1:
+;;    It now works in XEmacs -- patch from Hrvoje Niksic
+;;    
+
+;;; Code:
+
+(require 'timer)
+
+(eval-when-compile
+  (require 'cl))
+
+(require 'gamegrid)
+
+(defgroup keywiz nil
+  "Emacs key sequence quiz."
+  :version "21.2"
+  :group 'games
+  :group 'keyboard
+  :link '(emacs-commentary-link "keywiz.el"))
+
+(defface keywiz-wrong-face
+  '((t (:foreground "Red")))
+  "Face for wrong answers."
+  :group 'keywiz)
+
+(defface keywiz-right-face
+  '((t (:foreground "dark green")))
+  "Face for right answers."
+  :group 'keywiz)
+
+(defface keywiz-command-face
+  '((t (:foreground "Blue"
+	:weight bold
+	:height 1.2
+	:inherit 'variable-pitch)))
+  "Face for the Emacs commands."
+  :group 'keywiz)
+
+(defface keywiz-heading-face
+  '((t (:weight bold
+	:height 1.5
+	:inherit 'variable-pitch)))
+  "Face for headings."
+  :group 'keywiz)
+
+(defcustom keywiz-brief-flag t
+  "Non-nil means that only the first line of the doc-string is displayed."
+  :type '(choice (const t)
+		 (const nil))
+  :group 'keywiz)
+
+(defvar keywiz-cached-commands nil
+  "Command list from the previous run.")
+
+(defconst keywiz-right-phrases '("Excellent!" "Yes." "Indeed." "You're right."
+			       "t." "Spot-on." "Correct." "Yep."))
+(defconst keywiz-wrong-phrases '("Nope." "Wrong." "Nah." "nil." "No."
+			       "Incorrect." "(beep)" "Huh?" "Nay."))
+
+(defvar keywiz-temp-dir (if (fboundp 'temp-directory)
+			    (temp-directory)
+			  temporary-file-directory))
+
+(defvar keywiz-score-file
+  (if (fboundp 'gamegrid-add-score-insecure)
+      "keywiz-scores"
+    (expand-file-name "keywiz-scores"
+		      keywiz-temp-dir))
+  "File for holding high scores.")
+
+(defconst keywiz-time-limit 120)
+
+(defvar keywiz-not-key-regexp
+  (regexp-opt
+   '("mouse" "frame" "menu-bar" "mode-line" "compose-last-chars"
+     "vertical-line" "vertical-scroll-bar" "header-line"
+     "select-window")))
+
+(defvar keywiz-global-map nil)
+(defvar keywiz-local-map nil)
+
+(when (featurep 'xemacs)
+  (defun keywiz-events-to-keys (vector)
+    (map 'vector #'identity
+	 (delq nil (mapcar
+		    (lambda (el)
+		      (cond ((key-press-event-p el)
+			     (let ((mods (event-modifiers el))
+				   (key  (event-key el)))
+			       (when (characterp key)
+				 (setq key (intern (make-string 1 key))))
+			       (if mods
+				   (append mods (list key))
+				 key)))
+			    ((or (symbolp el)
+				 (characterp el)
+				 (listp el))
+			     el)))
+		    vector)))))
+
+(defun keywiz-key-press-event-p (x)
+  "Return t if X is a keyboard event."
+  (let ((event (append x nil)))
+    (when (consp event)
+      (setq event (car event)))
+    (if (symbolp event)
+	(not (string-match keywiz-not-key-regexp
+			   (prin1-to-string
+			    (car (get event 'event-symbol-elements)))))
+      t)))
+
+(defun keywiz-insert-with-face (face &rest str)
+  "Insert STR with face FACE."
+  (put-text-property (point)
+		     (progn
+		       (mapcar 'insert str)
+		       (point))
+		     'face face))
+
+;; Emacs 20.7 doesn't have float-time
+
+(defalias 'keywiz-float-time
+  (if (fboundp 'float-time)
+      'float-time
+    (lambda ()
+      (let ((s (current-time)))
+	(+ (* (car s) 65536.0) (cadr s))))))
+
+(defun keywiz-random (x)
+  "Return random element from list X."
+  (nth (random (length x)) x))
+
+(defun keywiz (rescan)
+  "Start the key sequence quiz.
+If RESCAN (the prefix) is non-nil, force a rescan of the key bindings.
+Keywiz uses the key bindings for the buffer where it is invoked.
+Press `q' to quit before the two minute time limit is over.  Press `r'
+to pause keywiz and enter a recursive edit in the *scratch* buffer."
+  (interactive "P")
+  (let ((score 0)
+	(first t)
+	commands start-time timer doc key input quit)
+    (random t)
+    (message "Finding key bindings...")
+    ;; It's probably *much* faster to find the bindings by searching
+    ;; the keymaps -- but this is easier:
+    (if (and (not rescan) keywiz-cached-commands)
+	(progn (setq commands keywiz-cached-commands)
+	       (message "Finding all key bindings...cached (use C-u to rescan)"))
+      (do-all-symbols (sym)
+	(when (and (commandp sym)
+		   (not (memq sym '(self-insert-command
+				    digit-argument undefined))))
+	  (let ((keys (apply 'nconc (mapcar
+				     (lambda (key)
+				       (when (keywiz-key-press-event-p key)
+					 (list key)))
+				     (where-is-internal sym)))))
+	    ;;  Politically incorrect, but clearer version of the above:
+	    ;;	  (let ((keys (delete-if-not 'keywiz-key-press-event-p
+	    ;;				     (where-is-internal sym))))
+	    (and keys
+		 (push (list sym keys) commands)))))
+      (setq keywiz-cached-commands commands)
+      (message "Finding key bindings...done")
+      (setq keywiz-global-map (current-global-map)
+	    keywiz-local-map (current-local-map)))
+    (setq start-time (keywiz-float-time))
+    
+    (switch-to-buffer (get-buffer-create "*keywiz*"))
+    (use-global-map keywiz-global-map)
+    (use-local-map keywiz-local-map)
+    (make-local-variable 'mode-line-format)
+    ;; Use unwind-protect to make sure the timer is killed.
+    (unwind-protect
+	(progn
+	  (setq timer
+		(run-with-timer
+		 0 1
+		 (lambda ()
+		   (setq mode-line-format
+			 (list "(keywiz)  Score: " (number-to-string score)
+			       " Time left: "
+			       (number-to-string
+				(round (- keywiz-time-limit
+					  (- (keywiz-float-time)
+					     start-time))))))
+		   (force-mode-line-update))))
+	  (erase-buffer)
+	  (keywiz-insert-with-face
+	   'keywiz-heading-face "Welcome to keywiz\n")
+	  (insert "There are currently " (number-to-string (length commands))
+		  (substitute-command-keys
+		   " commands.  Your current score and the time left is
+displayed in the mode line.  Press `q' to quit before the time limit is over.
+Press `r' to pause and enter a recursive edit, `\\[exit-recursive-edit]' (exit-recursive-edit)
+will return to keywiz.  This allows you to try out a command."))
+	  (while (and commands
+		      (not quit)
+		      (< (- (keywiz-float-time) start-time)
+			 keywiz-time-limit))
+	    (setq commands (remove (setq key (keywiz-random commands))
+				   commands))
+	    (keywiz-insert-with-face 'keywiz-command-face
+				     "\n\n"  (prin1-to-string (car key)))
+	    (when (setq doc (documentation (car key)))
+	      (insert "\n" (if keywiz-brief-flag
+			       (substring doc 0 (string-match "\n" doc))
+			     doc)))
+	    (insert "\n")
+	    ;; We need to recenter the first one differently because the
+	    ;; intro is longer.
+	    (if (not first)
+		(recenter 6)
+	      (recenter 8)
+	      (setq first nil))
+	    (if (featurep 'xemacs)
+		(setq input (keywiz-events-to-keys (read-key-sequence "?")))
+	      (setq input (read-key-sequence-vector "?")))
+	    (cond
+	     ((member input (cadr key))
+	      (keywiz-insert-with-face
+	       'keywiz-right-face
+	       (keywiz-random keywiz-right-phrases)
+	       "  The answer is: "
+	       (mapconcat 'key-description (cadr key) ", "))
+	      (incf score))
+	     ((setq quit (and (member input '([?q] [q]))
+			      (y-or-n-p "Do you want to quit? "))))
+	     ((member input '([?r] [r]))
+	      ;; 'r' means recursive muck-around with the timer stopped
+	      (keywiz-insert-with-face
+	       'keywiz-wrong-face "Time-out time-out! Question skipped.")
+	      (cancel-timer timer)
+	      (let ((timeout-start (keywiz-float-time)))
+		(cancel-timer timer)
+		(save-excursion
+		  (save-window-excursion
+		    (switch-to-buffer-other-window
+		     (get-buffer-create "*scratch*"))
+		    (recursive-edit)))
+		(timer-activate timer)
+		(incf start-time (- (keywiz-float-time) timeout-start))))
+	     (t
+	      (keywiz-insert-with-face
+	       'keywiz-wrong-face
+	       (keywiz-random keywiz-wrong-phrases)
+	       "  The correct answer is: "
+	       (mapconcat 'key-description (cadr key) ", "))))))
+	  (cancel-timer timer))
+      (keywiz-insert-with-face 'keywiz-heading-face "\n\nTime's up\n")
+      (insert "You made " (number-to-string score) " points.")
+      (gamegrid-add-score keywiz-score-file score)))
+
+(provide 'keywiz)
+
+;;; keywiz.el ends here
diff --git a/elisp/emacs-goodies-el/lcomp.el b/elisp/emacs-goodies-el/lcomp.el
new file mode 100755
index 0000000..e8f8f38
--- /dev/null
+++ b/elisp/emacs-goodies-el/lcomp.el
@@ -0,0 +1,253 @@
+;;; lcomp.el --- list completion hacks!
+
+;; Copyright (C) 2002, 2004, 2010 by Taiki SUGAWARA
+
+;; Author: Taiki SUGAWARA 
+;; Keywords: tools, convenience
+;; Version: 0.03
+;; Time-stamp: <2010-02-08 17:16:51 UTC taiki>
+;; URL: http://www.emacswiki.org/cgi-bin/wiki/lcomp.el
+;; URL: http://bitbucket.org/buzztaiki/elisp/src/tip/lcomp.el
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see .
+
+;;; Commentary:
+
+;; This package provides the following features:
+;;
+;;  - `lcomp-mode': make the completions buffer window disappear after
+;;	use.
+;;
+;;   - `lcomp-keys-mode': add keybindings to the completions buffer.
+;;
+;; To use this package, add these lines into your ~/.emacs file:
+;;
+;;     (require 'lcomp)
+;;     (lcomp-mode 1)
+;;     (lcomp-keys-mode 1)
+;;
+;; The completions buffer is usually only dismissed after completion
+;; when it is created from minibuffer completion, but `lcomp-mode'
+;; makes it get dismissed correctly from any buffer (e.g. shell, or by
+;; calling `comint-dynamic-complete-filename').
+
+;;; Key Bindings:
+
+;; `lcomp-mode' adds global keybindings if enabled:
+;;    "M-v"	  -> lcomp-select-completion-window-or-original
+;;     
+;; `lcomp-keys-mode' adds keybindings to the completions buffer if enabled:
+;;    "C-i"	  -> next-completion
+;;    "M-C-i"	  -> previous-completion
+;;    "f"	  -> next-completion
+;;    "b"	  -> previous-completion
+;;    "n"	  -> next-line
+;;    "p"	  -> previous-line
+;;    " "	  -> scroll-up
+;;    [del]	  -> scroll-down
+;;    [backspace] -> scroll-down
+;;    "q"	  -> delete-completion-window
+
+;;; History:
+;; 
+;;  2009-02-22 Peter S Galbraith 
+;;   - Reinsert defcustom `lcomp-enable' as an alternate and user-frienfly
+;;     method to enable the advice.
+
+;;; Code:
+(require 'easy-mmode)
+
+;; lcomp
+(defvar lcomp-before-completion-winconf nil
+  "This variable holds the before-completion window configulation.")
+(defvar lcomp-completion-halfway-p nil
+  "If non-nil, completion is halfway now.")
+(defvar lcomp-display-completion-buffer-p nil
+  "If non-nil completion buffer is displayed.")
+(defvar lcomp-completion-buffer nil
+  "This variable holds the completion buffer.")
+
+(defvar lcomp-mode-map
+  (let ((map (or (and (boundp 'lcomp-mode-map)
+		      (keymapp (symbol-value 'lcomp-mode-map))
+		      (symbol-value 'lcomp-mode-map))
+		 (make-sparse-keymap))))
+    (define-key map "\M-v" 'lcomp-select-completion-window-or-original)
+    map))
+
+(defadvice try-completion (after lcomp-ad disable)
+  (setq lcomp-completion-halfway-p (stringp ad-return-value)))
+
+(defadvice choose-completion (after lcomp-ad disable)
+  (when lcomp-before-completion-winconf
+    (lcomp-resume-before-completion-winconf-1)))
+
+(defadvice delete-completion-window (around lcomp-ad disable)
+  (if lcomp-before-completion-winconf
+      (let ((buf completion-reference-buffer))
+	(when (buffer-live-p buf)
+	  (switch-to-buffer buf))
+	(lcomp-resume-before-completion-winconf))
+    ad-do-it))
+
+(defun lcomp-setup-completion ()
+  (when (and (not lcomp-before-completion-winconf)
+	     (not (window-minibuffer-p)))
+    (setq lcomp-display-completion-buffer-p t)
+    (setq lcomp-completion-buffer standard-output)
+    (setq lcomp-before-completion-winconf (current-window-configuration))))
+
+(defun lcomp-resume-before-completion-winconf-1 ()
+  (condition-case err
+      (set-window-configuration lcomp-before-completion-winconf)
+    (error
+     (message "%s occured. bat ignore." (error-message-string err))))
+  (setq lcomp-before-completion-winconf nil)
+  (setq lcomp-completion-buffer nil))
+
+(defun lcomp-resume-before-completion-winconf ()
+  (when (and lcomp-before-completion-winconf
+	     (not (or (and (eq this-command 'self-insert-command)
+			   (string-match "\\(\\sw\\|\\s_\\)"
+					 (this-command-keys)))
+		      (eq (current-buffer) lcomp-completion-buffer)
+		      (window-minibuffer-p)
+		      lcomp-display-completion-buffer-p
+		      lcomp-completion-halfway-p)))
+    (let ((buf (current-buffer)))
+      (lcomp-resume-before-completion-winconf-1)
+      (when (and (not (eq buf (current-buffer)))
+		 (buffer-live-p buf))
+	(switch-to-buffer buf))))
+  (setq lcomp-display-completion-buffer-p nil)
+  (setq lcomp-completion-halfway-p nil))
+
+(defun lcomp-select-completion-window ()
+  (interactive)
+  (when (and lcomp-completion-buffer
+	     (get-buffer-window lcomp-completion-buffer))
+    (select-window (get-buffer-window lcomp-completion-buffer))))
+
+(defun lcomp-select-completion-window-or-original ()
+  (interactive)
+  (or (lcomp-select-completion-window)
+      (let ((minor-mode-overriding-map-alist
+	     '((lcomp-mode . nil))))
+	(call-interactively (or (key-binding (this-command-keys-vector))
+				'ignore)))))
+
+(defun lcomp--install ()
+  (add-hook 'completion-setup-hook 'lcomp-setup-completion)
+  (add-hook 'post-command-hook 'lcomp-resume-before-completion-winconf)
+
+  (ad-enable-regexp "^lcomp-ad$")
+  (ad-activate-regexp "^lcomp-ad$" t))
+
+
+(defun lcomp--uninstall ()
+  (remove-hook 'completion-setup-hook 'lcomp-setup-completion)
+  (remove-hook 'post-command-hook 'lcomp-resume-before-completion-winconf)
+
+  (ad-disable-regexp "^lcomp-ad$")
+  (ad-activate-regexp "^lcomp-ad$" t))
+
+;;;###autoload
+(define-minor-mode lcomp-mode
+  "Auto close completion window mode."
+  :group 'lcomp
+  :global t
+  (if lcomp-mode
+      (lcomp--install)
+    (lcomp--uninstall)))
+
+;; lcomp backward compatibility
+(make-obsolete 'lcomp-install 'lcomp-mode)
+(make-obsolete 'lcomp-uinstall 'lcomp-mode)
+(make-obsolete 'lcomp-activate-advices 'lcomp-mode)
+
+(defun lcomp-install ()
+  "Install lcomp.
+This adds some hooks, advices, key definitions."
+  (interactive)
+  (lcomp-mode 1))
+
+(defun lcomp-uninstall ()
+  "Uninstall lcomp.
+This removes some hooks, advices, key definitions."
+  (interactive)
+  (lcomp-mode -1))
+
+(defun lcomp-activate-advices (on)
+  "Activate lcomp advices if ON is non-nil, disable otherwise."
+  (if on
+      (lcomp-mode 1)
+    (lcomp-mode -1)))
+
+;; lcomp-keys
+(defvar lcomp-keys-override-map
+  (let ((map (or (and (boundp 'lcomp-keys-override-map)
+		      (keymapp (symbol-value 'lcomp-keys-override-map))
+		      (symbol-value 'lcomp-keys-override-map))
+		 (make-sparse-keymap))))
+    (define-key map "\C-i" 'next-completion)
+    (define-key map "\M-\C-i" 'previous-completion)
+    (define-key map "f" 'next-completion)
+    (define-key map "b" 'previous-completion)
+    (define-key map "n" 'next-line)
+    (define-key map "p" 'previous-line)
+    (define-key map " " 'scroll-up)
+    (define-key map [del] 'scroll-down)
+    (define-key map [backspace] 'scroll-down)
+    (define-key map "q" 'delete-completion-window)
+    map))
+
+(defun lcomp-keys-override ()
+  (push (cons 'lcomp-keys-mode
+	      lcomp-keys-override-map)
+	minor-mode-overriding-map-alist))
+
+;;;###autoload
+(define-minor-mode lcomp-keys-mode
+  "Add keybindings to the completions buffer.
+
+\\{lcomp-keys-override-map}"
+  :global t
+  (if lcomp-keys-mode
+      (add-hook 'completion-list-mode-hook 'lcomp-keys-override)
+    (remove-hook 'completion-list-mode-hook 'lcomp-keys-override)))
+
+(defgroup lcomp nil
+  "list-completion hacks."
+  :group 'completion)
+
+(defcustom lcomp-enable nil
+  "*Enable advice in lcomp to make completion buffer disappear after use."
+  :type 'boolean
+  :set (lambda (symbol value)
+	 (set-default symbol value)
+	 (cond
+          ((and lcomp-enable
+                (featurep 'lcomp))
+           (lcomp-mode 1)
+           (lcomp-keys-mode 1))
+          ((and (not lcomp-enable)
+                (featurep 'lcomp))
+           (lcomp-mode 0)
+           (lcomp-keys-mode 0))))
+  :require 'lcomp
+  :group 'lcomp)
+
+(provide 'lcomp)
+
+;;; lcomp.el ends here
diff --git a/elisp/emacs-goodies-el/map-lines.el b/elisp/emacs-goodies-el/map-lines.el
new file mode 100755
index 0000000..a663181
--- /dev/null
+++ b/elisp/emacs-goodies-el/map-lines.el
@@ -0,0 +1,167 @@
+;;; map-lines.el --- Map a command over many lines
+
+;; Copyright (C) 2002  Andreas Fuchs 
+;; Copyright (C) 2010  Paul Hobbs 
+
+;; Author: Andreas Fuchs 
+;; Maintainer: Paul Hobbs 
+;; Keywords: matching, files
+
+;; 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:
+
+;; ------------------------------ TYPICAL USE ------------------------------
+;; This module allows you to map a command over a set of lines
+;; matching a regex.  The trick: You can then go ahead and insert these
+;; lines in one clean yank.
+;;
+;; Example text:
+;; 
+;;     Hello,
+;;     Here are the requested documents:
+;;     a.txt
+;;     b.txt
+;;     c.txt
+;;     Also, I have included the following:
+;;     license.txt
+;;
+;; Running M-x map-lines-copy-regex ".txt" will give you
+;;     a.txt
+;;     b.txt
+;;     c.txt
+;;     license.txt
+;;
+;; This is also useful for using Emacs with UNIX: just run M-! ls, and filter
+;; out the files you want to operate on using map-lines-kill, or grab those you
+;; want using map-lines-copy.  Then, paste into a scratch buffer and use
+;; keyboard macros and/or rectangles to form the commands you want to run on
+;; each file, and to execute each command.  Nifty!
+
+;; ------------------------------ INSTALLATION ------------------------------
+;; To use this module, put this file somewhere in your load-path and this into
+;; your .emacs:
+;; (load-library "map-lines")
+;; 
+;; Alternatively, you can autoload the functions one at a time, which will
+;; reduce your Emacs start-up time and typical RAM usage (slightly):
+;;     (autoload 'map-lines "map-lines"
+;;       "For each matching line, kill, copy or run a custom command" t)
+;;     (autoload 'map-lines-kill "map-lines" "Kill each line matching regex" t)
+;;     (autoload 'map-lines-copy "map-lines" "Copy each line matching regex" t)
+;;     (autoload 'copy-line      "map-lines" "Copy the current line" t)
+;;
+;; You can set (recommended) keyboard shortcuts using
+;;     (global-set-key (kbd "C-c m l") 'map-lines)
+;;     (global-set-key (kbd "C-c m k") 'map-lines-kill)
+;;     (global-set-key (kbd "C-c m c") 'map-lines-copy)
+;;     (global-set-key (kbd "C-x c")
+;;
+;; ... or your own key combinations as you see fit.
+
+;; ------------------------------ VERSIONS ------------------------------
+;; This is version 0.2 of map-lines.el.
+;;
+;; You can find the latest version of this module in the debian package
+;; emacs-goodies-el.  If you want to see new features, feel free to add them and
+;; email the maintainer of this package.
+;; 
+;;; History:
+;;
+;; Version 0.2
+;;  - Changed map-lines to always put a newline between each line, and added
+;;    kill-lines and copy-lines.  (Paul Hobbs)
+;;
+;; Version 0.1
+;;  - First version (Andreas Fuchs)
+
+;;; Code:
+
+(defvar mapl-command-alist
+  '((?k . mapl-kill-line)
+    (?c . mapl-copy-line)
+    (?o . mapl-other-command))
+  "An alist of command-char->command-name mappings.")
+
+
+(defun mapl-lookup-command (command-char)
+  "Return the matching command for COMMAND-CHAR."
+  (let ((command (cdr (assq command-char mapl-command-alist))))
+    (if (eq command 'mapl-other-command)
+	(read-command "Other command (takes no args and returns a string): ")
+      command)))
+
+;;;###autoload
+(defun map-lines (command-c regex)
+  "Map a COMMAND-C (kill, copying, or a custom command) over lines matching REGEX."
+  (interactive "cCommand (Kill, Copy, Other) [kco]:
+sRegular Expression: ")
+  (save-excursion
+    (let ((command (mapl-lookup-command command-c))
+	  (live-buffer (current-buffer)))
+      (with-temp-buffer
+	(let ((temp-buffer (current-buffer)))
+	  (with-current-buffer live-buffer
+	    (goto-char (point-min))
+	    (while (re-search-forward regex nil t)
+	      (let ((the-line (funcall command)))
+	        (with-current-buffer temp-buffer
+		  (insert the-line)
+		  (newline)))
+	      (end-of-line)))
+	  (kill-region (point-min) (point-max)))))))
+
+(defun mapl-kill-line ()
+  "Kill a line entirely and return it."
+  (mapl-kill-universal (lambda () (kill-line))))
+
+
+;;;###autoload
+(defun copy-line ()
+  "Copy a whole line to the kill ring."
+  (interactive)
+  (let ((original-point (point)))
+    (copy-region-as-kill (progn (beginning-of-line)
+				(point))
+			 (progn (end-of-line)
+				(point)))
+    (goto-char original-point)))
+
+(defun mapl-copy-line ()
+  "Copy a line entirely and return it."
+  (mapl-kill-universal (lambda () (copy-line))))
+
+(defun mapl-kill-universal (kill-fun)
+  "Execute KILL-FUN on an entire line."
+  (beginning-of-line)
+  (funcall kill-fun)
+  (prog1 (car kill-ring)
+    (setq kill-ring (cdr kill-ring))))
+
+;;;###autoload
+(defun map-lines-kill (regex)
+  "Kill all lines matching REGEX.  Yanking will insert all killed lines."
+  (interactive "sRegular Expression: ")
+  (map-lines ?\k regex))
+
+;;;###autoload
+(defun map-lines-copy (regex)
+  "Copy all lines matching REGEX to the kill ring.  Yanking will insert all such lines."
+  (interactive "sRegular Expression: ")
+  (map-lines ?\c regex))
+
+(provide 'map-lines)
+;;; map-lines.el ends here
diff --git a/elisp/emacs-goodies-el/maplev.el b/elisp/emacs-goodies-el/maplev.el
new file mode 100644
index 0000000..343ea40
--- /dev/null
+++ b/elisp/emacs-goodies-el/maplev.el
@@ -0,0 +1,5430 @@
+;;; maplev.el --- Maple mode for GNU Emacs
+;;
+;;
+;; Copyright (C) 2001,2003,2008,2009 Joseph S. Riel
+
+;; Authors:    Joseph S. Riel 
+;;             and Roland Winkler 
+;; Created:    June 1999
+;; Version:    2.27
+;; Keywords:   Maple, languages
+
+;;{{{ 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.  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 St, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;;}}}
+;;{{{ Introduction
+
+;;; Commentary:
+;;
+;; This package defines five major modes:
+;;
+;;   maplev-mode:        for editing Maple code
+;;   maplev-cmaple-mode: for running Maple
+;;   maplev-mint-mode:   for displaying the output of mint
+;;   maplev-help-mode:   for displaying Maple help pages
+;;   maplev-proc-mode:   for displaying Maple procedures
+
+;;; Features:
+
+;; font-lock (highlighting) of Maple keywords
+;; automatic indentation
+;; syntax checking (via Mint)
+;; online Maple help
+;; online display of Maple procedures
+;; outlining (not yet)
+;; narrowing (nothing here)
+;; tags
+;; imenu support
+;; auto-fill support
+
+;;; Installation:
+
+;; Put this file into your Emacs load path and byte compile it.  Add
+;; the following to your `.emacs':
+;;
+;;   (autoload 'maplev-mode "maplev" "Maple editing mode" t)
+;;   (autoload 'cmaple      "maplev" "Start maple process" t)
+;;
+;; To have Emacs automagically start in MapleV mode when editing Maple
+;; source, add the following to your .emacs, modifying the regexp
+;; `.mpl' to an extension appropriate for your usage:
+;;
+;;   (setq auto-mode-alist (cons `("\\.mpl\\'" . maplev-mode) auto-mode-alist))
+;;
+;; YOU MUST customize some of the default settings to be appropriate
+;; for your installation.  You can do this in several ways.  The most
+;; user friendly way is to use `customize'.  You can do this with:
+;;
+;;   M-x load-library RET maplev RET
+;;   M-x customize-group RET maplev RET
+;;
+;; The important options are in the subgroup `maplev-important'.  After
+;; setting and testing these options, save them to your .emacs by
+;; clicking on the `Save for Future Sessions' button.
+;;
+;;
+;;; History:
+
+;; Oct 99:  Initial release.
+
+;;}}}
+;;{{{ To Do
+
+;; High Priority:
+;; - make `maplev-beginning-of-proc' and `maplev-end-of-proc' more reliable.
+;;
+;; Medium Priority:
+;; - add comment-out functions
+;; - pass `maplev-beginning-of-proc' (or faster) to `font-lock-defaults'.
+;;   That should speed up fontification with lazy(?) lock.  Testing.
+;; - add clean up routine to kill buffers and processes
+;;   when exiting maplev-mode
+;; - indent continued assignments (this could be tricky)
+;; - more complete definition of maplev-completion-alist based on
+;;   the maple help node `index[package]'
+;;
+;; Low Priority:
+;; - font lock local variables
+;; - fix problem with folding
+
+;;}}}
+
+;;; Code:
+
+;;{{{ Information
+
+(defconst maplev-version "2.27" "Version of MapleV mode.")
+
+(defconst maplev-developer 
+  "Joseph S. Riel "
+  "Developers/maintainers of maplev-mode.")
+
+(defun maplev-about ()
+  (interactive)
+  (sit-for 0)
+  (message "maplev-mode version %s, (C) %s" maplev-version maplev-developer))
+
+;;}}}
+
+(require 'abbrevlist)
+(require 'font-lock)
+(require 'comint)
+(require 'info)
+(require 'button-lock)
+
+(eval-and-compile
+  (condition-case nil (require 'imenu) (error nil))
+  (condition-case nil (require 'align) (error nil)))
+
+(defsubst maplev--short-delay ()
+  "Pause for a brief duration."
+  (sleep-for 0.1))
+
+;;{{{ Compatibility assignments
+
+(eval-and-compile
+  (if (not (boundp 'folding-mode)) (defvar folding-mode nil))
+  (if (not (fboundp 'folding-open-buffer)) (defun folding-open-buffer ()))
+
+  (defvar maplev-xemacsp
+    (or (featurep 'xemacs)
+        (string-match "XEmacs\\|Lucid" (emacs-version)))
+    "*Non-nil when running under under Lucid Emacs or Xemacs.")
+
+  (when (or (string< emacs-version "20.4") maplev-xemacsp)
+    (defun line-beginning-position (&optional n)
+      "Return the character position of the first character on the current line.
+With argument N not nil or 1, move forward N - 1 lines first.
+If scan reaches end of buffer, return that position.
+This function does not move point."
+      (save-excursion
+        (beginning-of-line n)
+        (point)))
+
+    (defun line-end-position (&optional n)
+      "Return the character position of the last character on the current line.
+With argument N not nil or 1, move forward N - 1 lines first.
+If scan reaches end of buffer, return that position.
+This function does not move point."
+      (save-excursion
+        (end-of-line n)
+        (point))))
+
+  (if maplev-xemacsp
+      (defun match-string-no-properties (num &optional string)
+        "Return string of text matched by last search, without text 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.
+STRING should be given if the last search was by `string-match' on STRING."
+        (if (match-beginning num)
+            (if string
+                (let ((result
+                       (substring string (match-beginning num) (match-end num))))
+                  (set-text-properties 0 (length result) nil result)
+                  result)
+              (buffer-substring-no-properties (match-beginning num)
+                                              (match-end num))))))
+
+  ;; The following two inline functions are needed by GNU emacs.
+  ;; They mimic the builtin Xemacs functions.
+  (unless maplev-xemacsp
+    (defun event-window (event)
+      "Return the window over which mouse EVENT occurred."
+      (nth 0 (nth 1 event)))
+    (defun event-point (event)
+      "Return the character position of the mouse EVENT."
+      (posn-point (event-start event))))
+
+  (defun maplev--mouse-keymap (keys)
+    "Generate vector keymap for KEYS corresponding to a mouse button.
+It handles the difference between Emacs and Xemacs.  KEYS is a list, the last item
+is an integer correspond to the button number; preceding items are optional modifiers"
+    (let ((rkeys (reverse keys)))
+      (setcar rkeys (intern (concat (if maplev-xemacsp "button" "mouse-")
+                                    (number-to-string (car rkeys)))))
+      (vector (reverse rkeys)))))
+
+;;}}}
+
+;;{{{ Group definitions
+
+(defgroup maplev nil
+  "Major mode for editing Maple source in Emacs"
+  :group 'languages)
+
+(defgroup maplev-important nil
+  "STUFF THAT MUST BE CONFIGURED."
+  :group 'maplev)
+
+(defgroup maplev-declarations nil
+  "Customizations for declaring variables."
+  :group 'maplev)
+
+(defgroup maplev-faces nil
+  "Faces for highlighting text in MapleV mode."
+  :group 'maplev)
+
+(defgroup maplev-executables nil
+  "Maple and Mint location and configuration."
+  :group 'maplev)
+
+(defgroup maplev-templates nil
+  "Procedure template and other shortcuts."
+  :group 'maplev)
+
+(defgroup maplev-misc nil
+  "Miscellaneous options."
+  :group 'maplev)
+
+(defgroup maplev-align nil
+  "Alignment variables."
+  :group 'maplev)
+
+;;}}}
+;;{{{ Configurable options
+
+;;{{{   executables
+
+(defun maplev-windows-executables (major-release &optional num-exe ini-file)
+  (let ((num (if num-exe major-release "")))
+  (list (format "c:/Program Files/Maple Release %s/bin.wnt/cmaple%s.exe" major-release num)
+        ini-file
+        (format "c:/Program Files/Maple Release %s/bin.wnt/mint%s.exe" major-release num)
+        )))
+
+(defcustom maplev-executable-alist
+  (if (string-match "windows-nt\\|ms-dos" (symbol-name system-type))
+      `(("16" . ,(maplev-windows-executables "16" t))
+	("15" . ,(maplev-windows-executables "15" t))
+        ("14" . ,(maplev-windows-executables "14" t))
+        ("13" . ,(maplev-windows-executables "13" t))
+        ("12" . ,(maplev-windows-executables "12" t))
+        ("11" . ,(maplev-windows-executables "11" t))
+        ("10" . ,(maplev-windows-executables "10" t))
+        ("9"  . ,(maplev-windows-executables "9"  t))
+        ("8"  . ,(maplev-windows-executables "8"  t))
+        ("7"  . ,(maplev-windows-executables "7"  t))
+        ("6"  . ,(maplev-windows-executables "6"  t))
+        ("5"  . ,(maplev-windows-executables "5"  t))
+        ("4"  . ,(maplev-windows-executables "4"  t))
+        ("3"  . ,(maplev-windows-executables "3"  t)))
+
+    '(
+      ("16"  . ("maple" nil "mint"))
+      ("15"  . ("maple" nil "mint"))
+      ("14"  . ("maple" nil "mint"))
+      ("13"  . ("maple" nil "mint"))
+      ("12"  . ("maple" nil "mint"))
+      ("11"  . ("maple" nil "mint"))
+      ("10"  . ("maple" nil "mint"))
+      ("9"   . ("maple" nil "mint"))
+      ("8"   . ("maple" nil "mint"))
+      ("7"   . ("maple" nil "mint"))
+      ("6"   . ("maple" nil "mint"))
+      ("5.1" . ("maple" nil "mint"))
+      ("5"   . ("maple" nil "mint"))
+      ("4"   . ("maple" nil "mint"))))
+  "Assoc list specifying the available executables.
+Each item has the form \(RELEASE MAPLE MAPLE-INIFILE MINT\)
+where RELEASE is the Maple release corresponding to the
+executables MAPLE and MINT.  MAPLE must be the command line
+\(non-GUI\) version of Maple.  MAPLE-INIFILE is the maple
+initialization file for running Maple under Emacs;
+if nil the default initialization file is used."
+  :type '(repeat (list (string :tag "Maple Release")
+                       (file   :tag "Maple Executable")
+                       (choice :tag "Maple Initialization File"
+                               file (const :tag "none" nil))
+                       (file   :tag "Mint Executable ")))
+  :group 'maplev-executables
+  :group 'maplev-important)
+
+;; this isn't quite right, it doesn't permit assigning
+;; a new release.
+
+(defcustom maplev-default-release "15"
+  "Release of Maple used as the default executable.
+It must be a key in `maplev-executable-alist'."
+  :type `(choice ,@(mapcar (lambda (item)
+                             (list 'const (car item)))
+                           maplev-executable-alist))
+  :group 'maplev-executables
+  :group 'maplev-important)
+
+(defvar maplev-release maplev-default-release
+  "Buffer local string variable assigned the selected release of Maple.
+Used to index `maplev-executable-alist'.")
+(make-variable-buffer-local 'maplev-release)
+
+(defconst maplev-interface-kernelopts-settings
+  (concat "interface('prettyprint=1,verboseproc=2,errorbreak=0,warnlevel=2,errorcursor=false,screenheight=infinity'):\n"
+          "kernelopts('printbytes=false'):\n" )
+  "Maple commands that assign the default interface and kernelopts settings." )
+
+(defcustom maplev-default-init-string
+  (concat
+   "maplev_print := `if`(assigned(maplev['PrintProc']),maplev:-PrintProc,print):\n"
+   maplev-interface-kernelopts-settings)
+  "Default Maple commands used to initialize a Maple process.
+Use `maplev-init-string-alist' to customize initialization commands
+for particular releases.")
+
+(defcustom maplev-init-string-alist
+  (let ((init
+         (concat
+          "if not assigned(maplev_print) then maplev_print := proc(n)print(`if`(type(evaln(n),'procedure'),eval,readlib)(n))end:fi:\n"
+          maplev-interface-kernelopts-settings)))
+    `(("5.1" . ,init)
+      ("5"   . ,init)))
+  "Assoc list of Maple commands initializing a maple session.
+Each item has the form \(RELEASE COMMANDS\) where RELEASE is the
+Maple release.  COMMANDS must be a string of Maple commands.
+Overrides `maplev-default-init-string'."
+  :type '(repeat (cons (string :tag "Maple Release")
+                       (string :tag "Maple Commands")))
+  :group 'maplev-executables
+  :group 'maplev-important)
+
+(defcustom maplev-mint-info-level 3
+  "Integer controlling amount of information that Mint outputs."
+  :type '(choice (const :tag "no info" 0)
+                 (const :tag "severe errors" 1)
+                 (const :tag "+ serious errors" 2)
+                 (const :tag "+ warnings" 3)
+                 (const :tag "full report" 4))
+  :group 'maplev-mint)
+
+(defcustom maplev-mint-error-level 1
+  "Integer controlling Mint error checking in Maple input."
+  :type '(choice (const :tag "no info" 0)
+                 (const :tag "severe errors" 1)
+                 (const :tag "+ serious errors" 2)
+                 (const :tag "+ warnings" 3)
+                 (const :tag "full report" 4))
+  :group 'maplev-mint)
+
+(defcustom maplev-mint-start-options (list "-q")
+  "List of mint command line options.  
+Do not include the info level or the include path,
+they are handled by `maplev-mint-info-level' and `maplev-include-path'."
+  :type 'list
+  ;;   :type '(repeat (choice (const :tag "no logo" " -q")
+  ;;                       (const :tag "suppress startup" " -s")
+  ;;                       (const :tag "syntax only" " -S")
+  ;;                       (const :tag "cross reference" " -x")
+  ;;                       (list :tag "library" (const " -b") directory)
+  ;;                       (list :tag "append database" (const " -a ") file)
+  ;;                       (list :tag "use database" (const " -d ") file)
+  ;;                       (list :tag "toggle error" (const " -t ") (string :tag "error number"))))
+
+  :group 'maplev-mint)
+
+(defcustom maplev-include-path nil
+  "List of directories to search for files to include.
+Each element is a string (directory name) or nil.
+The directories are passed to maple and to mint 
+via the \"-I\" option; they are searched for files
+specified in Maple preprocessor $include directives."
+  :type '(choice (const nil) (repeat string))
+  :group 'maplev-executables
+  :group 'maplev-mint)
+
+(make-variable-buffer-local 'maplev-include-path)
+
+;;}}}
+;;{{{   comments
+
+(defcustom maplev-comment-column 40
+  "Column for inline comments.
+Use \\[indent-for-comment] to insert or align an inline comment."
+  :type 'integer
+  :group 'maplev-comments)
+
+(defcustom maplev-comment-start "#"
+  "String to insert to start a Maple inline comment."
+  :type 'string
+  :group 'maplev-comments)
+
+;; not used by GNU emacs 21
+(defcustom maplev-block-comment-start "# "
+  "String to insert to start a Maple standalone comment."
+  :type 'string
+  :group 'maplev-comments)
+
+(defcustom maplev-auto-fill-comment-flag t
+  "Non-nil means initially enable `auto-fill-mode' in a Maple buffer."
+  :type 'boolean
+  :group 'maplev-comments)
+
+;;}}}
+;;{{{   declarations
+
+(defcustom maplev-var-declaration-symbol " :: "
+  "Separator inserted between declared variable and type."
+  :type 'string
+  :group 'maplev-declarations)
+
+(defcustom maplev-alphabetize-declarations-p nil
+  "If non-nil, variable declarations are alphabetized.
+Only works if `maplev-add-declaration-function' is assigned
+either `maplev-add-declaration-leading-comma' or
+`maplev-add-declaration-trailing-comma'."
+  :type 'boolean
+  :group 'maplev-declarations)
+
+(defcustom maplev-add-declaration-function 'maplev-add-declaration-trailing-comma
+  "Selects the function that adds variables to a declaration."
+  :type '(radio
+          (function-item :doc "declarations on one line" maplev-add-declaration-one-line)
+          (function-item :doc "declarations on separate lines, with leading comma" maplev-add-declaration-leading-comma)
+          (function-item :doc "declarations on separate lines, with trailing comma" maplev-add-declaration-trailing-comma))
+  :group 'maplev-declarations)
+
+
+
+
+;;}}}
+;;{{{   indentation
+
+(defcustom maplev-indent-level 4
+  "Indentation of Maple statements with respect to containing block."
+  :type 'integer
+  :group 'maplev-indentation)
+
+(defcustom maplev-indent-declaration 0
+  "Indentation of Maple declarations \(local, global, option, description\)."
+  :type 'integer
+  :group 'maplev-indentation)
+
+(defcustom maplev-dont-indent-re "[#$]"
+  "Lines starting with this regular expression will not be auto-indented."
+  :type '(choice string (const :tag "default" nil))
+  :group 'maplev-indentation)
+
+(defcustom maplev-auto-break-strings-flag t
+  "Strings in code will be automatically broken when they pass the `current-fill-column'."
+  :type 'boolean
+  :group 'maplev-indentation)
+
+;;}}}
+;;{{{   templates
+
+(defcustom maplev-copyright-owner "John Q. Public"
+  "Copyright owner inserted in the copyright string by `maplev--template-proc-module'."
+  :type 'string
+  :group 'maplev-templates
+  :group 'maplev-important)
+
+(defcustom maplev-comment-end-flag t
+  "Non-nil means add a template's name as a comment following the end.
+See `maplev--template-proc-module'."
+  :type 'boolean
+  :group 'maplev-templates)
+
+;;; The reason for making this [the following] customizable is to
+;;; support mapledoc, a LaTeX package.  To hide the name of the
+;;; template in the the typeset output, I use the string " #% ".  To
+;;; display it I might use " #\# ", which also prints the hash.
+
+(defcustom maplev-template-end-comment " # "
+  "String prepended to the name of a template at the end,
+following the \"end\".  See `maplev-comment-end-flag'."
+  :type 'string
+  :group 'maplev-templates)
+
+(defcustom maplev-insert-copyright-flag t
+  "Non-nil means insert `maplev-copyright-owner' in a template.
+See `maplev-template'."
+  :type 'boolean
+  :group 'maplev-templates)
+
+(defcustom maplev-description-quote-char ?\`
+  "Quote character for the description statement.
+Maple uses a backquote; however, in R5 it makes more sense to use a
+double quote.  Procbody, alas, does not handle a double quote."
+  :type 'character
+  :group 'maplev-templates)
+
+(defcustom maplev-variable-spacing 0
+  "Spaces to insert after a comma in declarations and argument lists."
+  :type 'integer
+  :group 'maplev-templates)
+
+(defcustom maplev-assignment-operator " := "
+  "Maple assignment operator.  Used by `maplev-insert-assignment-operator'."
+  :type 'string
+  :group 'maplev-templates)
+
+;;}}}
+;;{{{   completion
+
+(defcustom maplev-completion-longdelim-p nil
+  "If non-nil use the long delimiter when completing a Maple control structure.
+For example, if non-nil, a `do' loop is completed with `end do',
+otherwise it is completed with `od'.  If the maple release is less than 6
+than the long delimiter is never used."
+  :type 'boolean
+  :group 'maplev-completions)
+
+;;}}}
+;;{{{   miscellaneous
+
+;; Leading commas
+
+(defcustom maplev-leading-comma-flag t
+  "Non-nil means the user prefers leading commas when continuing lines.
+Currently this only determines whether advice for `fixup-whitespace'
+is activated when maplev-mode is executed."
+  :type 'boolean
+  :group 'maplev-misc)
+
+;; Abbrev mode
+
+(defcustom maplev-initial-abbrev-mode-flag nil
+  "Non-nil means initially enable function `abbrev-mode' in a Maple buffer."
+  :type 'boolean
+  :group 'maplev-misc)
+
+(defcustom maplev-expand-abbrevs-in-comments-and-strings-flag nil
+  "Non-nil means expand Maple abbreviations in comments and strings.
+Nil means do not expand in either."
+  :type 'boolean
+  :group 'maplev-misc
+  :group 'maplev-comments)
+
+(defcustom maplev-include-file-other-window-flag t
+  "Non-nil means the default action is to open an include file
+in the other window. See `maplev-find-include-file'."
+  :type 'boolean
+  :group 'maplev-misc)
+
+;; Configuration
+
+(defcustom maplev-buttonize-includes-flag t
+  "Non-nil means use `button-lock-mode' to hyperlink include statements."
+  :type 'boolean
+  :group 'maplev-misc)
+
+(defcustom maplev-load-config-file-flag t
+  "Non-nil means load a configuration file when starting maplev-mode.
+The configuration file is named .maplev and is searched for in the current directory
+and its ancestors.  The file is loaded as an elisp file.  No error occurs if
+the file does not exist."
+  :type 'boolean
+  :group 'maplev-misc)
+
+;; Saving
+
+(defcustom maplev-clean-buffer-before-saving-flag t
+  "Non-nil means run `maplev-remove-trailing-spaces' before saving."
+  :type 'boolean
+  :group 'maplev-misc)
+
+;;}}}
+;;{{{   align rules
+
+;; Define the maplev alignment rules.
+;; Align the assignment operator (`:='), equals signs,
+;; columns (`|'), commas, double colons (`::'), and comments.  
+;; Columns and commas are aligned only if the
+;; the prefix argument is active (i.e. C-u M-x align).
+;; The comment rule is the last rule so that comments are properly aligned.
+
+(eval-and-compile
+  (when (featurep 'align)
+    (defcustom maplev-align-rules-list
+      '((maple-assignment-rule
+         (regexp   . "\\s-*\\w+\\(\\s-*:\\)=\\(\\s-*\\)")
+         (group    . (1 2))
+         (justify  . t)
+         (tab-stop . nil))
+        (maple-equals-rule
+         (regexp   . "\\s-*\\w+\\(\\s-*\\)=\\(\\s-*\\)")
+         (group    . (1 2))
+         (repeat   . t)
+         (tab-stop . nil))
+        (maple-type-rule
+         (regexp   . "\\s-*\\w+\\(\\s-*\\)::\\(\\s-*\\)")
+         (group    . (1 2))
+         (repeat   . t)
+         (tab-stop . nil))
+        (maple-column-delimiter
+         (regexp . "\\(\\s-*\\)\|\\(\\s-*\\)")
+         (group  . (1 2))
+         (repeat . t)
+         (run-if lambda nil current-prefix-arg))
+        (maple-comma-delimiter
+         (regexp . ",\\(\\s-*\\)\\S-")
+         (repeat . t)
+         (run-if lambda nil current-prefix-arg))
+        (maple-comment
+         (regexp . "\\(\\s-+\\)\\s<")
+         (column . comment-column)))
+      "A list describing the maplev alignment rules.
+See the documentation for `align-rules-list' for more info on the format."
+      :type align-rules-list-type
+      :group 'maplev-align)
+
+    ;; Define the alignment exclusion rules.
+    ;; The prevent changing quoted material and comments.
+
+    (defcustom maplev-align-exclude-rules-list
+      `((exc-dq-string
+         (regexp . "\"\\([^\"\n]+\\)\"")
+         (repeat . t))
+        (exc-sq-string
+         (regexp . "'\\([^'\n]+\\)'")
+         (repeat . t))
+        (exc-bq-string
+         (regexp . "`\\([^`\n]+\\)`")
+         (repeat . t))
+        (exc-open-comment
+         (regexp . ,(function
+                     (lambda (end reverse)
+                       (funcall (if reverse 're-search-backward
+                                  're-search-forward)
+                                (concat "[^ \t\n\\\\]"
+                                        (regexp-quote comment-start)
+                                        "\\(.+\\)$") end t))))))
+      "A list describing text that should be excluded from alignment.
+See the documentation for `align-exclude-rules-list' for more info."
+      :type align-rules-list-type
+      :group 'maplev-align)))
+
+;;}}}
+
+;;}}}
+;;{{{ Internal variables
+
+(defvar maplev-mint--code-buffer nil
+  "Buffer containing source code that was passed to Mint.")
+
+(defvar maplev-mint--code-beginning nil
+  "Marker at beginning of region in `maplev-mint--code-buffer' that was passed to Mint.")
+
+(defvar maplev-mint--code-end nil
+  "Marker at end of region in `maplev-mint--code-buffer' that was passed to Mint.")
+
+(defvar maplev-completion-alist nil
+  "Alist for minibuffer completion.
+It has the form ((maple-release1  (...)) (maple-release2 (...)))")
+
+(defvar maplev-completion-release nil
+  "Maple release for which completion has been requested.")
+
+(defvar maplev-history-list nil
+  "History list used by maplev.")
+
+(defvar maplev-use-indent-info t
+  "Buffer local variable that speeds up indentation when non nil.
+May interfere with some modes (e.g. noweb).")
+(make-variable-buffer-local 'maplev-use-indent-info)
+
+(defvar maplev--declaration-history nil
+  "History list used for type declarations.")
+
+
+;;}}}
+;;{{{ Regular expressions
+
+(defconst maplev--declaration-re
+  "\\<\\(?:local\\|options?\\|global\\|description\\|export\\|uses\\)\\>"
+  "Regular expression for a Maple procedure declaration statement.")
+
+(defconst maplev--simple-name-re  "\\_<[a-zA-Z_%][a-zA-Z0-9_?]*~?\\_>"
+  "Regular expression for a simple name.")
+
+(defconst maplev--quoted-name-re  "`[^`\n\\\\]*\\(?:\\\\.[^`\n\\\\]*\\)*`"
+  "Regular expression for a Maple quoted name.
+It correctly handles escaped backquotes in a name, but not doubled
+backquotes.  It intentionally fails for the exceptional case where a
+name has a newline character.")
+
+(defconst maplev--symbol-re (concat "\\(?:" 
+                                    maplev--simple-name-re 
+                                    "\\|"
+                                    maplev--quoted-name-re
+                                    "\\)")
+  "Regular expression for a Maple symbol.")
+
+(defconst maplev--name-re
+  (concat maplev--symbol-re             ; base name
+	  "\\(?:[ \t\n\f]*:-" maplev--symbol-re "\\)*" ; optional module components
+          "\\(?:[ \t\n\f]*\\[[^][]*\\]\\)*" ; optional indices
+          "\\(?:[ \t\n\f]*([^)(]*)\\)*") ; optional arguments
+  "Regular expression for Maple names.")
+
+;; (defconst maplev--var-with-optional-type (concat
+;;                                           "\\(" maplev--simple-name-re "\\)"
+;;                                           "\\(?:\\s-*::\\s-*"
+;;                                           "\\("
+;;                                           maplev--type-re
+;;                                           "\\)\\)?")
+;;   "Regular expression for a variable with optional type declaration.
+;; The variable matches group one, the type matches group 2.")
+
+
+(defconst maplev--comment-re "#.*$"
+  "Regular expression for Maple comments.
+A backslash at the end of the line does not continue the comment.")
+
+(defconst maplev--defun-re "\\(?:\\\\|\\\\)"
+  "Regular expression at start of a Maple procedure or module.")
+
+(defconst maplev--assignment-re
+  ;; Use "^" to anchor the regular expression.  This forces
+  ;; re-search-backward to match the complete assignee name, provided
+  ;; that the name is not a split between lines, a very poor practice.
+;;  (concat "^\\s-*"
+;;	  "\\(" maplev--name-re "\\)[ \t\n]*:=[ \t\n]*")
+;;  "Regular expression that matches a Maple assignment.")
+  (concat "\\(?:^\\|\\s-\\|[,]\\)"
+	  "\\('?" maplev--name-re "'?\\)[ \t\n]*:?=[ \t\n]*")
+  "Regular expression that matches a Maple assignment.")
+
+(defconst maplev--possibly-typed-assignment-re
+  (concat "^\\s-*\\(local\\|global\\|export\\)?\\s-*"
+          "\\('?" maplev--name-re "'?\\)"
+          "\\(?:[ \t\n]*::[ \t\n]*\\(" maplev--name-re "\\)\\)?"
+          "[ \t\n]*:?=[ \t\n]*")
+  "Regular expression that matches a Maple assignment that may
+include a type declaration.  The second group correponds to the
+assignee, the second group to the type.  This only works with
+an assignment to a name, it does not match an assignment to
+a sequence.")
+
+(defconst maplev--defun-begin-re
+  ;; This regular expression does not match a named module,
+  ;; nor does it match a procedure/module that is not an
+  ;; assignment statement.  
+  (concat maplev--possibly-typed-assignment-re ;; assignment-re
+          "\\(?:" maplev--comment-re "\\)?"
+          "[ \t\f\n]*" maplev--defun-re)
+  "Regular expression for Maple defun assignments.  
+The second group corresponds to the name of the defun.")
+
+(defconst maplev--top-defun-begin-re
+  (concat "^\\(" maplev--name-re "\\)[ \t\n]*:=[ \t\n]*"
+          "\\(?:" maplev--comment-re "\\)?"
+          "[ \t\f\n]*" maplev--defun-re)
+  "Regular expression for top level Maple defun assignments.
+The first group corresponds to the name of the defun.")
+
+
+(defconst maplev--defun-end-re
+  ;; This regular expression matches any nonqualified end statement,
+  ;; such as "do ... end"; however, I consider such code to be bad form
+  ;; (with the exception of procedures and modules, which allow it for
+  ;; historical reasons).  The proper technique is "do ... end do" or
+  ;; "do ... od".
+  (concat "\\"
+          "\\(?:[ \t]+" maplev--defun-re "\\)?"
+          "[ \t]*[:;]")
+  "Regular expression for \"end\" statement in a Maple defun.
+It does not allow linebreaks as this messes up searching.  
+It matches from the \"end\" to the terminating colon or semicolon.")
+
+(defconst maplev--top-defun-end-re
+  (concat "^\\(?:" maplev--defun-end-re "\\)" ; flush left end
+          "\\|"                         ; or
+          maplev--top-defun-begin-re "[^#\n]*" ; one line proc
+          maplev--defun-end-re)
+  "Regular expression for \"end\" statement in a top level Maple procedure assignment.
+It matches either a flush left \"end\" or a one line procedure assignment.")
+
+(defconst maplev--space-dot-quote-re "\\s-*\\.[`\"]") ; space could be allowed 'twixt dot and quote
+
+;;;(defconst maplev--quote-re "\"[^\"]*\"\\|`[^`]*`")    ; fails when a quote contains a quote.
+
+(defconst maplev--string-re "\"[^\"\\\\]*\\(\\\\[[:ascii:]][^\"\\\\]*\\)*\""
+  "Regular expression that matches a double-quoted Maple string.
+It matches even when a string contains newlines or escaped characters, 
+including double-quotes.")
+
+
+(defconst maplev--quote-re
+  (concat maplev--quoted-name-re
+          "\\|"
+          maplev--string-re)
+  "Regular expression that matches a backward-quoted name or double code string.")
+
+(eval-and-compile
+  (defun maplev--list-to-word-re (words)
+    "Generate a regular expression that matches one of WORDS, a list."
+    (concat "\\<\\(" (regexp-opt words) "\\)\\>")))
+
+;;}}}
+;;{{{ Syntax table
+
+(defvar maplev-mode-syntax-table nil
+  "Syntax table used in MapleV mode buffers \(except R4\).")
+
+(unless maplev-mode-syntax-table
+  (let ((table (make-syntax-table)))
+    (modify-syntax-entry ?_  "_"  table) ; symbol constituent
+    (modify-syntax-entry ?~  "_"  table) ; symbol constituent
+    (modify-syntax-entry ??  "_"  table) ; symbol constituent
+    (modify-syntax-entry ?&  "w"  table) ; word constituent
+    (modify-syntax-entry ?\\ "\\" table) ; escape
+    (modify-syntax-entry ?#  "<"  table) ; comment starter
+    (modify-syntax-entry ?\n ">"  table) ; newline = comment ender
+    (modify-syntax-entry ?\f ">"  table) ; formfeed = comment ender
+    (modify-syntax-entry ?\r " "  table) ; return = whitespace
+    (modify-syntax-entry ?\t " "  table) ; tab = whitespace
+
+    (modify-syntax-entry ?*  ". 23b"  table) ; punctuation and used in multiline comments (* ... *)
+    (modify-syntax-entry ?/  "."  table)
+    (modify-syntax-entry ?+  "."  table)
+    (modify-syntax-entry ?-  "."  table)
+    (modify-syntax-entry ?=  "."  table)
+    ;; this is for noweb-mode
+;;    (modify-syntax-entry ?<  ". 12"  table)
+;;    (modify-syntax-entry ?>  ". 34"  table)
+
+    (modify-syntax-entry ?.  "."  table)
+    (modify-syntax-entry ?\' "\"" table) ; string quotes
+    (modify-syntax-entry ?\` "\"" table) ; string quotes
+    (modify-syntax-entry ?\{ "(}" table) ; balanced brackets
+    (modify-syntax-entry ?\[ "(]" table)
+    (modify-syntax-entry ?\( "()1n" table)
+    (modify-syntax-entry ?\} "){" table)
+    (modify-syntax-entry ?\] ")[" table)
+    (modify-syntax-entry ?\) ")(4n" table)
+
+    ;; Entries for R5 and later
+    (modify-syntax-entry ?%  "."  table)
+    (modify-syntax-entry ?\" "\"" table)
+
+    ;; Entries for R12 and later.
+    ;; Define the multiline comment delimiters `(*' and `*)'.
+
+    (setq maplev-mode-syntax-table table)))
+
+(defvar maplev-mode-4-syntax-table nil
+  "Syntax table used in MapleV mode buffers for R4.")
+
+;; In R4 the ditto operator is `"'
+
+(unless maplev-mode-4-syntax-table
+  (setq maplev-mode-4-syntax-table
+        (copy-syntax-table maplev-mode-syntax-table))
+  (modify-syntax-entry ?\" "." maplev-mode-4-syntax-table))
+
+(defvar maplev--symbol-syntax-table nil
+  "Syntax table for Maple, where `_' is a word constituent.")
+
+(unless maplev--symbol-syntax-table
+  (setq maplev--symbol-syntax-table (copy-syntax-table maplev-mode-syntax-table))
+  (modify-syntax-entry ?_  "w"  maplev--symbol-syntax-table))
+
+(defvar maplev-help-mode-syntax-table nil
+  "Syntax table used in Maple help buffer.")
+
+(unless maplev-help-mode-syntax-table
+  (let ((table (make-syntax-table)))
+    (modify-syntax-entry ?_ "w" table)
+    (setq maplev-help-mode-syntax-table table)))
+
+;;}}}
+
+;;{{{ Indentation
+
+;; The indentation functions handle the indentation of Maple code.
+;; They are based on the Maple-mode package written by Nicholas
+;; Thie'ry.  Considerable changes have been made to handle the
+;; extended syntax introduced in Maple R6.  Following is a brief
+;; description of the algorithm.
+;; 
+;; The buffer local list variable `maplev--update-indent-info' stores
+;; the indentation information at a particular point, call it the
+;; `known-indent-point' (the point position is stored in the list).
+;; When a line is indented, the algorithm checks whether the current
+;; position is greater than `known-indent-point'; if so, it only needs
+;; to check between that point and the current position.  If not, it
+;; needs to search backwards for a known valid indentation point.  The
+;; function `maplev--validate-indent-info' handles this.
+;;
+;; The amount that a particular line is indented is determined by the
+;; grammar defined by the constant assoc list `maplev--grammar-alist'. 
+ 
+
+
+;;{{{   module
+
+;; Define variables and functions for handling indentation information.
+
+(defvar maplev--indent-info nil
+  "Buffer local variable storing previous indent information.
+
+Nil when there is no previous, or valid, indent information.
+Otherwise it's a list: \(POINT STATE STACK\).  POINT is the
+buffer character position at which the information applies.
+STATE is the output of `parse-partial-sexp' \(valid from the
+start of the buffer to POINT\).  STACK is a list of lists, each
+list having the form \(KEYWORD INDENT-CLOSE INDENT-FOLLOW\).
+KEYWORD is a keyword or parenthesis in the source.  INDENT-CLOSE
+is the indentation for the closing keyword associated with
+KEYWORD.  INDENT-FOLLOW is the indentation for source between
+KEYWORD and its closing keyword.  Indentation is measured in 
+characters, with 0 being the left margin.")
+
+;; Procedures for accessing the contents of `maplev--indent-info'.
+
+(defsubst maplev--indent-info-point ()
+  "Return position of last valid indent."
+  (nth 0 maplev--indent-info))
+
+(defsubst maplev--indent-info-state ()
+  "Return output of `parse-partial-sexp' from last indent."
+  (nth 1 maplev--indent-info))
+
+(defsubst maplev--indent-info-stack ()
+  "Return indentation stack."
+  (nth 2 maplev--indent-info))
+
+(defsubst maplev--indent-info-assign (point state stack)
+  "Assign POINT, STATE, and STACK to the variable `maplev--indent-info'."
+  (setq maplev--indent-info (list point state stack)))
+
+(defsubst maplev-clear-indent-info ()
+  "Clear the indent information."
+  (interactive)
+  (setq maplev--indent-info nil))
+
+
+(defun maplev--validate-indent-info ()
+  "Update the variable `maplev--indent-info' if nil.
+Set POINT in variable to closest valid starting point.
+Set STATE and STACK in variable to nil."
+  (unless (and 
+           maplev-use-indent-info
+           maplev--indent-info
+	   (>= (point) (maplev--indent-info-point)))
+    ;; Set POINT to (point) if we're at the beginning of a top level
+    ;; procedure assignment, otherwise search backwards for the
+    ;; beginning or end of a top level procedure assignment and put
+    ;; point outside it.  If neither is found, move point to the start
+    ;; of the buffer.  WHAT ABOUT NARROWING AND/OR FOLDING?
+    (maplev--indent-info-assign
+     (or (and (looking-at maplev--top-defun-begin-re) (point))
+         ;; Handle noweb mode.
+         ;; If noweb is active in the buffer, then search for
+         ;; the chunk starter.
+         ;;(and 
+          ;;(boundp 'noweb-minor-mode) noweb-minor-mode
+          ;;(eq mmm-classes 'noweb)
+         (save-excursion
+           (when (re-search-backward "^<<\\(.*\\)>>=$" nil t)
+             (1+ (match-end 0))))
+         (save-excursion
+           (when (re-search-backward
+                  (concat "\\(" maplev--top-defun-begin-re "\\)\\|"
+                          "\\(" maplev--top-defun-end-re "\\)") nil t)
+             (if (nth 2 (match-data))   ; found proc?
+                 (match-beginning 0)    ;   start of proc
+               (match-end 0))))         ;   end of proc
+         (point-min))                   ; top of buffer
+     nil nil)))
+
+(defun maplev--before-change-function (beg &rest unused)
+  "Clear indent info if the buffer change is before the last info location.
+This function is called whenever the buffer is changed.  BEG is the
+character position of the beginning of the change.  UNUSED is not used."
+  (and maplev--indent-info
+       (< beg (maplev--indent-info-point))
+       (maplev-clear-indent-info)))
+
+;;}}}
+;;{{{   grammar
+
+(defconst maplev--grammar-alist 
+
+;; Removed "in" from grammar to allow its use as a binary operator in Maple R8.
+;; The change in the indentation is minor; rarely is there a line break between 
+;; an "in" and the "do" in a loop.
+
+  (list
+   (list "proc" . ("\\" t maplev-indent-level 'maplev--indent-point-of-proc))
+   (list "module" . ("\\" t maplev-indent-level 'maplev--indent-point-of-proc))
+   (list "end"  . (nil nil 0 nil 'maplev--skip-optional-end-keyword))
+;;;          (list "for"  . ((maplev--list-to-word-re '("from" "to" "by" "while" "in" "do")) t 0))
+   (list "for"  . ((maplev--list-to-word-re '("from" "to" "by" "while" "do")) t 0))
+   (list "from" . ((maplev--list-to-word-re '("to" "by" "while" "do")) t 0))
+   (list "to"   . ((maplev--list-to-word-re '("by" "while" "do")) t 0))
+   (list "by"   . ((maplev--list-to-word-re '("from" "to" "while" "do")) t 0))
+   (list "while" . ((maplev--list-to-word-re '("from" "to" "by" "do")) t 0))
+;;;          (list "in"   . ((maplev--list-to-word-re '("while" "do" "end")) t maplev-indent-level))
+   (list "do"   . ((maplev--list-to-word-re '("od" "end")) t maplev-indent-level))
+   (list "od"   . (nil nil 0))
+   
+   (list "if"   . ("\\" t 0))
+   (list "elif" . ("\\" nil 0))
+   (list "else" . ((maplev--list-to-word-re '("fi" "end")) nil maplev-indent-level))
+   (list "then" . ((maplev--list-to-word-re '("elif" "else" "fi" "end")) nil maplev-indent-level))
+   (list "fi"   . (nil nil 0))
+   
+;;;          (list "use"  . ("\\" t maplev-indent-level))
+   (list "use"  . ("\\" t maplev-indent-level))
+   (list "try"  . ((maplev--list-to-word-re '("catch" "finally" "end")) t maplev-indent-level))
+   (list "catch". ((maplev--list-to-word-re '("catch" "finally" "end")) t maplev-indent-level))
+   (list "finally". ((maplev--list-to-word-re '("end")) t maplev-indent-level))
+   
+   (list "{"    . ("}" t nil))
+   (list "["    . ("]" t nil))
+   (list "("    . (")" t nil))
+   (list "}"    . (nil nil 0))
+   (list "]"    . (nil nil 0))
+   (list ")"    . (nil nil 0)))
+
+  "Assoc list defining the grammar for Maple indentation.
+Each entry has the form \(KEY . \(MATCH-RE OPEN-P INDENT ADJUST-FUNC
+POST-FUNC\)\).  KEY is a Maple keyword or parenthesis.  MATCH-RE is a
+regular expression that matches any of the keys that follow KEY; nil
+means that KEY closes a Maple statement.  OPEN-P is a boolean flag
+that is non-nil if KEY can initiate a Maple statement.  INDENT is the
+relative indentation for the block immediately following KEY; nil
+means that the indentation is handled in an ad hoc fashion.
+ADJUST-FUNC is optional, if non-nil it is a function that moves point
+to the position from where the indent is computed.  POST-FUNC is
+optional, if non-nil it is a function that is called after the keyword
+is handled.  Currently it is only used by the keyword `end'.")
+
+
+
+
+(defconst maplev--grammar-keyword-re
+  (eval-when-compile
+    (concat
+     ;;     (maplev--list-to-word-re
+     (maplev--list-to-word-re
+      '("proc" "module" "end"
+;;;      "for" "from" "to" "by" "while" "in" "do" "od"
+        "for" "from" "to" "by" "while" "do" "od"
+        "if" "elif" "else" "then" "fi"
+        "use" "try" "catch" "finally"))
+     "\\|\\("
+     (regexp-opt '("{" "}" "[" "]" "(" ")" "(*" "*)" ))
+     "\\)"))
+  "Regular expression of keywords used in Maple grammar for indentation.")
+
+(defun maplev--skip-optional-end-keyword ()
+  "Skip the optional keyword following an end statement."
+  (if (looking-at (concat "[ \t]+"
+                          (maplev--list-to-word-re '("proc" "module" "do" "use" "if" "try"))))
+      (goto-char (match-end 0))))
+
+;;}}}
+;;{{{   errors
+
+;; Create a new error symbol, `keyword-out-of-sequence', for handling
+;; keywords and parentheses that appear out of sequence during an
+;; indentation.  It isn't clear to me that this is the proper way to
+;; handle this rather special condition; but I'll go with it for now.
+
+(put 'keyword-out-of-sequence
+     'error-conditions
+     '(error keyword-out-of-sequence))
+
+(put 'keyword-out-of-sequence 'error-message "Keyword out of sequence")
+
+(defun maplev--handle-grammar-error (err)
+  "Handle a grammar error ERR.
+Push the mark \(so that we can return to it with \\[universal-argument] \\[set-mark-command]\),
+ding the bell, display a message, and move point to the
+start of the offending keyword."
+  (push-mark)
+  (ding)
+  (message "Keyword `%s' out of sequence" (nth 1 err))
+  (goto-char (nth 2 err)))
+
+;;}}}
+;;{{{   functions
+
+(defun maplev-goto-previous-codeline ()
+  "Move point to the start of the previous line of Maple code.
+Blank lines and comment lines are skipped.
+THIS WILL FAIL IN A STRING."
+  (interactive)
+  (while (and (= (forward-line -1) 0)
+              (looking-at "\\s-*\\(#\\|$\\)"))))
+
+(defun maplev--indent-point-of-proc ()
+  "Move point to position from where a procedure is indented.
+Point must originally be just to the left of the \"proc\" or \"module\".
+If procedure is anonymous, point is not moved and nil is returned.
+Otherwise point is moved to left of assignee and point is returned."
+  ;; Regexp does not include possible comments.
+  (and (re-search-backward (concat maplev--possibly-typed-assignment-re "\\=") nil t)
+       (goto-char (match-beginning 2))))
+
+(defun maplev--indent-line-with-info ()
+  "Indent the current line as Maple code.  Point must be at the left margin."
+  (unless (or (and maplev-dont-indent-re
+                   (looking-at maplev-dont-indent-re))
+              (let ((state (maplev--indent-info-state)))
+                (or (nth 3 state) (nth 4 state))))
+    (delete-region (point) (progn (skip-chars-forward " \t") (point)))
+    (indent-to (maplev--compute-indent (car (maplev--indent-info-stack))))))
+
+;;}}}
+;;{{{   algorithm
+
+;; Algorithm:
+
+;; The indentation algorithm is intended to provide rapid indentation
+;; both for interactive use, that is, using `maplev-indent-newline',
+;; and for global use, that is, using `maplev-indent-region'.
+;;
+;; To rapidly indent a region, previous indentation information is
+;; stored in data structure, `maplev--indent-info'.  See its docstring
+;; for a description of the structure.  To interactively indent, the
+;; data is checked to see if there is usable information.  If so, it
+;; is used, otherwise the nearest preceding syntactically
+;; grammatically point (the start or end of a top level procedure
+;; assignment) is found and the indentation information computed from
+;; that point.
+
+
+(defun maplev--update-indent-info ()
+  "Update the variable `maplev--indent-info' at point.
+Scan the source for keywords and parentheses from the previous valid
+indent position to point.  Update the stack and state according to the
+syntax table and the grammar, `maplev--grammar-alist'.  Restore point.
+The calling function must ensure that the previous info point is not
+beyond \(point\)."
+
+;; This uses unwind-protect to restore the syntax table.
+;; Why not use with-syntax-table instead?  One excuse for
+;; not changing this is that with-syntax-table is more complicated,
+;; it uses unwind-protect as well as save-current-buffer.
+  (save-excursion
+    (let ((point (maplev--indent-info-point))
+          (stack (maplev--indent-info-stack))
+          (state (maplev--indent-info-state))
+          (end (point))
+          (previous-syntax-table (syntax-table))
+
+          keyword keyword-beginning key-list indent indent-close
+          adjust-func post-func top-stack old-keyword match-re
+          case-fold-search)
+
+      (unwind-protect
+          (save-restriction
+            (widen)
+
+            ;; Change the buffer syntax table to maplev--symbol-syntax-table 
+            ;; so that the underscore is considered a word constituent.
+
+            (set-syntax-table maplev--symbol-syntax-table)
+            (goto-char point)
+            (while (re-search-forward maplev--grammar-keyword-re end 'move)
+
+              ;; Assign loop variables.  KEY-POINT is assigned the position
+              ;; after the next keyword.  If no keyword exists in the line,
+              ;; KEY-POINT is nil.
+              
+              (setq keyword (match-string-no-properties 0)
+                    key-list (cdr (assoc keyword maplev--grammar-alist))
+                    indent (nth 2 key-list)
+                    adjust-func (nth 3 key-list)
+                    post-func (nth 4 key-list)
+                    top-stack (car stack)
+                    indent-close (nth 1 top-stack)
+                    old-keyword (car top-stack) ; Don't set to (old) KEYWORD, it might have been matched
+                    match-re (and old-keyword
+                                  (car (cdr (assoc old-keyword maplev--grammar-alist))))
+                    keyword-beginning (match-beginning 0)
+                    state (parse-partial-sexp point (point) nil nil state)
+                    point (point))
+              (cond
+               
+               ;; If KEYWORD is in a comment or a quote, do nothing.
+               ((or (nth 4 state) (nth 3 state) (string= keyword "*)"))) ; comments are more frequent, so check first
+               
+               ;; Does KEYWORD pair with the top one on STACK?
+               ((and match-re (string-match match-re keyword))
+                ;; Should more keywords follow KEYWORD?
+                (if (nth 0 key-list)
+                    ;; If so, replace the top of STACK with a new list.  The
+                    ;; new list has the new KEYWORD, the INDENT-CLOSE from
+                    ;; the old list, and
+                    (setcar stack (list keyword
+                                        indent-close
+                                        (+ indent-close indent)))
+                  ;; otherwise pop the top of STACK.
+                  (and post-func (funcall post-func))
+                  (setq stack (cdr stack))))
+
+               ;; Is KEYWORD an opening keyword?  Push a new item onto
+               ;; STACK.
+
+               ((nth 1 key-list)
+                (setq stack
+                      (cons
+                       (cons
+                        keyword
+                        ;; Handle keywords and parentheses appropriately.
+                        ;; Indentation for keywords that
+                        ;; start a Maple statement is from
+                        ;; `keyword-beginning'; however, if the
+                        ;; keyword is an assigned proc then the actual
+                        ;; beginning of the keyword is the start of
+                        ;; the assigned name.
+                        (if indent
+                            (save-excursion
+                              (goto-char keyword-beginning)
+                              (and adjust-func (funcall adjust-func))
+                              (list (current-column) ; alignment for closing keyword
+                                    (+ (current-column) indent))) ; alignment for subblock
+
+                          ;; Handle an open parenthesis.  INDENT-CLOSE is
+                          ;; set to the same column as the parerenthesis so
+                          ;; that the closing parenthesis is aligned.  If
+                          ;; space or a a comment follows the parenthesis,
+                          ;; then the following block of code is indented
+                          ;; from the current indentation.  Otherwise
+                          ;; following code indents to first character
+                          ;; following the parenthesis.
+                          (list
+                           (1- (current-column)) ; INDENT-CLOSE
+                           (progn
+                             (skip-chars-forward " \t")
+                             (if (looking-at "#\\|$") ; no code on remainder of line
+                                 (+ (current-indentation) maplev-indent-level)
+                               (current-column))))))
+                       stack)))
+
+               ;; KEYWORD is out of sequence.  Move point before KEYWORD and
+               ;; signal an error.
+               (t (re-search-backward keyword)
+                  (signal 'keyword-out-of-sequence (list keyword (point))))))
+            (if (< point end)
+                (setq state (parse-partial-sexp point (point) nil nil state)))
+            (maplev--indent-info-assign end state stack))
+        ;; Restore the syntax table
+        (set-syntax-table previous-syntax-table)))))
+
+;;}}}
+;;{{{   commands
+
+(defun maplev--compute-indent (indent-info)
+  "Return the indentation required for a Maple code line.
+INDENT-INFO is the indentation information applicable to this line;
+it is a list of three items: \(KEYWORD INDENT-CLOSE INDENT-FOLLOW\).
+See `maplev--indent-info' for details.  If INDENT-INFO is nil then 0
+is returned.  Point must be at current indentation."
+  (if (not indent-info)
+      0
+    (save-excursion
+      (let ((point (point))
+            case-fold-search)
+        (cond
+         ;; Handle declarations in procedures (and modules)
+         ((and (string-match maplev--defun-re (car indent-info))
+               (with-syntax-table maplev--symbol-syntax-table
+                 (looking-at maplev--declaration-re)))
+          (+  maplev-indent-declaration
+              (nth 1 indent-info)))
+         ;; Continued dotted quotes, e.g. ``."a string".''
+         ;; They are aligned with previous quoted material.
+         ;; There should be a flag to disable this.
+         ((and
+           (looking-at maplev--space-dot-quote-re)
+           (not (bobp))
+           (save-excursion
+             (maplev-goto-previous-codeline)
+             (setq point (point))
+             (end-of-line)
+             (setq point (re-search-backward maplev--quote-re point 'move))))
+          (goto-char point)
+          (max 0 (1- (current-column))))
+
+         ;; We've handled the special cases.
+         ;; Now to tackle regular statements.
+         (t
+          (or
+           (let* ((old-keyword (car indent-info))
+                  (match (and old-keyword (nth 1 (assoc old-keyword maplev--grammar-alist)))))
+             (nth (if (and match (looking-at match))
+                      1
+                    2)
+                  indent-info))
+           0)))))))                     ; maplev--compute-indent
+
+(defun maplev-indent-region (beg end)
+  "Indent the region between POINT and MARK.
+BEG and END may also be passed to the function."
+  (interactive "r")
+  (condition-case err
+      (save-excursion
+        (let ((before-change-functions nil)
+              (after-change-functions nil))
+          ;; Clear the indent stack.  Goto to the start of the region.
+          ;; Set up a marker for the end of the region (it is used to
+          ;; compute the percent completed).
+          (goto-char beg)
+          (beginning-of-line)
+          (setq end (set-marker (make-marker) end))
+          (maplev-clear-indent-info)   ; temporary
+          (maplev--validate-indent-info)
+
+          ;; THE FOLLOWING LINE IS EXPERIMENTAL BUT SEEMS NECESSARY
+          (maplev--update-indent-info)
+          ;; Indent each line in the region
+
+          (while (and (<= (point) end) (not (eobp)))
+            (maplev--indent-line-with-info)
+            (forward-line)
+            (maplev--update-indent-info)
+            (message "Indenting...(%d%%)"
+                     (min 100 (* 10 (/ (* 10 (- (point) beg)) (- end beg))))))
+
+          (message "Indenting...done")
+          (set-marker end nil)))
+
+    (keyword-out-of-sequence
+     (maplev--handle-grammar-error err)))) ; {end} maplev-indent-region
+
+
+(defun maplev-indent-buffer ()
+  "Indent the buffer."
+  (interactive)
+  (save-restriction
+    (widen)
+    (maplev-indent-region (point-min) (point-max))))
+
+(defun maplev-indent-procedure ()
+  "Indent the current procedure or module."
+  (interactive)
+  (apply 'maplev-indent-region (maplev-current-defun)))
+
+(defun maplev-indent-line ()
+  "Indent current line according to grammar.
+If point was to the left of the initial indentation, it moves to the
+final indentation; otherwise it remains in the same position relative
+to the indentation."
+  (interactive)
+  ;; 25-Feb-2001: Added condition-case to move cursor to an out of sequence keyword.
+  (condition-case err
+      (let ((before-change-functions nil))
+        (goto-char (max (save-excursion
+                          (beginning-of-line)
+                          (maplev--validate-indent-info)
+                          (maplev--update-indent-info)
+                          (maplev--indent-line-with-info)
+                          (point))
+                        (point))))
+    (keyword-out-of-sequence
+     (maplev--handle-grammar-error err))))
+
+;; This is used by `indent-for-comment' to decide how much to indent a
+;; comment in Maple code based on its context.
+
+(defun maplev-comment-indentation ()
+  "Return the column at which a comment should be started or moved to.
+If the line starts with a flush left comment, return 0."
+  (if (looking-at "^#")
+      0                         ; Existing comment at bol stays there.
+    comment-column))
+
+;; Xmaple doesn't support selections
+(defun maplev-insert-cut-buffer (&optional arg)
+  "Inserts the value of the X server cut-buffer 0.
+Text string is added to kill ring. Prefix arguments are interpreted as
+with \\[yank]."
+  (interactive "*P")
+  (kill-new (x-get-cut-buffer 0))
+  (setq this-command 'yank)
+  (yank arg))
+
+;; borrowed from mouse-yank-at-click
+(defun maplev-mouse-yank-cut-buffer (click arg)
+  "Inserts the value of the X server cut-buffer 0 at the position clicked on.
+Also move point to one end of the text thus inserted (normally the end),
+and set mark at the beginning.
+Prefix arguments are interpreted as with \\[yank].
+If `mouse-yank-at-point' is non-nil, insert at point
+regardless of where you click."
+  (interactive "e\nP")
+  (kill-new (x-get-cut-buffer 0))
+  ;; Give temporary modes such as isearch a chance to turn off.
+  (run-hooks 'mouse-leave-buffer-hook)
+  (or mouse-yank-at-point (mouse-set-point click))
+  (setq this-command 'yank)
+  (setq mouse-selection-click-count 0)
+  (yank arg))
+
+;;}}}
+
+;;}}}
+
+;;{{{ Mode map
+
+(defvar maplev-mode-map nil
+  "Keymap used in Maple mode.")
+
+(unless maplev-mode-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map [(tab)]                      'maplev-electric-tab)
+    (define-key map [(meta tab)]                 'maplev-complete-symbol)
+    (define-key map [(control c) (meta tab)]     'maplev-add-exports-of-module-at-point)
+    (define-key map [(backspace)]                'backward-delete-char-untabify)
+    (define-key map [(control backspace)]        'maplev-untab)
+    (define-key map [(control ?\;)]              'maplev-insert-assignment-operator)
+    (define-key map [(control c) (control t) ?p] 'maplev-template-proc)
+    (define-key map [(control c) (control t) ?m] 'maplev-template-module)
+    (define-key map [(control c) (control t) ?u] 'maplev-template-use-statement)
+
+    (define-key map [(control j)]                'maplev-indent-newline)
+    (define-key map [(control return)]           'maplev-newline-and-comment)
+    (define-key map [(meta control h)]           'maplev-mark-defun)
+    ;;  (define-key map [(meta control a)]           'maplev-beginning-of-proc)
+    ;;  (define-key map [(meta control e)]           'maplev-end-of-proc)
+    (define-key map [(control x) ?n ?d]          'maplev-narrow-to-defun)
+
+
+    ;; These two bindings are needed only under linux / unix
+    (define-key map [(meta control y)]          'maplev-insert-cut-buffer)
+    (define-key map (maplev--mouse-keymap '(control meta 2)) 'maplev-mouse-yank-cut-buffer)
+
+    (define-key map [(control c) (control l)] 'maplev-add-local-variable)
+    (define-key map [(control c) (control g)] 'maplev-add-global-variable)
+    (define-key map [(control c) (control e)] 'maplev-add-export-variable)
+
+    ;; Indent commands
+    (define-key map [(control c) (tab) ?b]  'maplev-indent-buffer)
+    (define-key map [(control c) (tab) tab] 'maplev-indent-buffer)
+    (define-key map [(control c) (tab) ?p]  'maplev-indent-procedure)
+    (define-key map [(control c) (tab) ?r]  'maplev-indent-region)
+    (define-key map [(control c) (tab) ?k]  'maplev-clear-indent-info)
+    
+
+    ;; Cmaple commands
+    (define-key map [(control c) (control c) ?b]      'maplev-cmaple-send-buffer)
+    (define-key map [(control c) (control c) ?p]      'maplev-cmaple-send-procedure)
+    (define-key map [(control c) (control c) ?r]      'maplev-cmaple-send-region)
+    (define-key map [(control c) (control c) ?l]      'maplev-cmaple-send-line)
+    (define-key map [(control c) (control c) return]  'maplev-cmaple-send-line)
+    (define-key map [(control c) (control c) ?g]      'maplev-cmaple-pop-to-buffer)
+    (define-key map [(control c) (control c) ?i]      'maplev-cmaple-interrupt)
+    (define-key map [(control c) (control c) ?k]      'maplev-cmaple-kill)
+    (define-key map [(control c) (control c) ?s]      'maplev-cmaple-status)
+
+    ;; Mint commands    
+
+    (define-key map [(control c) return ?b] 'maplev-mint-buffer)
+    (define-key map [(control c) return ?p] 'maplev-mint-procedure)
+    (define-key map [(control c) return ?r] 'maplev-mint-region)
+    (define-key map [(control c) return return] 'maplev-mint-rerun)
+
+    ;; Help and proc comma    
+      
+    (define-key map [(control ?\?)] 'maplev-help-at-point)
+    (define-key map [(meta ?\?)]    'maplev-proc-at-point)
+    (define-key map [(control h) (meta d)] 'maplev-what-proc)
+
+    ;; Xemacs and FSF Emacs use different terms for mouse buttons
+
+    (define-key map (maplev--mouse-keymap '(control shift 2)) 'maplev-help-follow-mouse)
+    (define-key map (maplev--mouse-keymap '(meta shift 2))    'maplev-proc-follow-mouse)
+
+    (define-key map [(control c) (control s) ?h] 'maplev-switch-buffer-help)
+    (define-key map [(control c) (control s) ?l] 'maplev-switch-buffer-proc)
+    (define-key map [(control c) (control s) ?c] 'maplev-switch-buffer-cmaple)
+
+    (setq maplev-mode-map map)))
+
+;;}}}
+;;{{{ Menu
+
+(defvar maplev--menu-decoration
+  '(["reserved words"  (maplev-reset-font-lock 1) :style radio
+     :selected (equal font-lock-maximum-decoration 1)]
+    ["+ special words"  (maplev-reset-font-lock 2) :style radio
+     :selected (equal font-lock-maximum-decoration 2)]
+    ["+ builtin functions"  (maplev-reset-font-lock 3) :style radio
+     :selected (or (equal font-lock-maximum-decoration 3)
+                   (equal font-lock-maximum-decoration t))])
+  "Menu items for changing the decoration level in Maple mode.")
+
+(defvar maplev-menu nil)
+(unless maplev-menu
+  (easy-menu-define
+    maplev-menu maplev-mode-map
+    "Menu for MapleV mode."
+    `("MapleV"
+      ("Indent"
+       ["Buffer"    maplev-indent-buffer t]
+       ["Procedure" maplev-indent-procedure t]
+       ["Region"    maplev-indent-region t])
+      ("Mint"
+       ["Buffer"    maplev-mint-buffer t]
+       ["Procedure" maplev-mint-procedure t]
+       ["Region"    maplev-mint-region t]
+       ["Rerun"     maplev-mint-rerun :active maplev-mint--code-beginning]
+       "---"
+       ("Mint level"
+        ["severe errors"    (setq maplev-mint-info-level 1) :style radio :selected (= maplev-mint-info-level 1)]
+        ["+ serious errors" (setq maplev-mint-info-level 2) :style radio :selected (= maplev-mint-info-level 2)]
+        ["+ warnings"       (setq maplev-mint-info-level 3) :style radio :selected (= maplev-mint-info-level 3)]
+        ["full report"      (setq maplev-mint-info-level 4) :style radio :selected (= maplev-mint-info-level 4)]))
+      ("Maple"
+       ["Goto buffer"    maplev-cmaple-pop-to-buffer t]
+       ["Send buffer"    maplev-cmaple-send-buffer t]
+       ["Send procedure" maplev-cmaple-send-procedure t]
+       ["Send region"    maplev-cmaple-send-region t]
+       ["Send line"      maplev-cmaple-send-line t]
+       "---"
+       ["Interrupt"   maplev-cmaple-interrupt t]
+       ["Kill"        maplev-cmaple-kill t])
+      ("Help"
+       ["Word"        maplev-help-at-point t]
+       ["Highlighted" maplev-help-region t])
+      "---"
+      ("Setup"
+       ("Maple Release"
+        ,@(mapcar (lambda (item)
+                    (let ((key (car item)))
+                      `[,key (maplev-set-release ,key)
+                             :style radio
+                             :selected (string= maplev-release ,key)]))
+                  maplev-executable-alist))
+       ("Abbrevs"
+        ["Enable abbrevs" abbrev-mode
+         :style toggle :selected abbrev-mode]
+        ["List abbrevs" maplev-abbrev-help t])
+       ["Enable auto-fill comments" (setq maplev-auto-fill-comment-flag (not maplev-auto-fill-comment-flag))
+	:style toggle :selected maplev-auto-fill-comment-flag]
+       ["Enable auto-string break" (setq maplev-auto-break-strings-flag (not maplev-auto-break-strings-flag))
+	:style toggle :selected maplev-auto-break-strings-flag]
+       ["Use leading commas" (setq maplev-leading-comma-flag (not maplev-leading-comma-flag))
+	:style toggle :selected maplev-leading-comma-flag]
+       ("Decoration" ,@maplev--menu-decoration))
+      "---"
+      ["Add Index" maplev-add-imenu (not (and (boundp 'imenu--index-alist)
+                                              imenu--index-alist))]
+
+      "---"
+      ["Quit"      quit-window t]
+      "---"
+      ["Info"  maplev-goto-info-node t]
+      ["About" maplev-about t])))
+
+;;}}}
+;;{{{ Abbreviations
+
+(defun maplev--abbrev-hook ()
+  "Unexpand an abbreviation in a string or a comment.
+The variable `maplev-expand-abbrevs-in-comments-and-strings-flag'
+controls the expansion."
+  (unless maplev-expand-abbrevs-in-comments-and-strings-flag
+    ;; Searching can be expensive:
+    ;; We assume that strings do not span more than one line
+    (let ((state (parse-partial-sexp (maplev-safe-position) (point))))
+      (if (or (nth 4 state) (nth 3 state))
+          (unexpand-abbrev)))))
+
+(defvar maplev-mode-abbrev-table nil
+  "Abbrev table used in MapleV mode buffers.")
+
+(unless maplev-mode-abbrev-table
+  (let ((ac abbrevs-changed))
+    (define-abbrev-table
+      'maplev-mode-abbrev-table
+      '(("ar"    "array"      maplev--abbrev-hook 0)
+        ("ass"   "assigned"   maplev--abbrev-hook 0)
+        ("co"    "convert"    maplev--abbrev-hook 0)
+        ("err"   "ERROR"      maplev--abbrev-hook 0)
+        ("fail"  "FAIL"       maplev--abbrev-hook 0)
+        ("fr"    "from"       maplev--abbrev-hook 0)
+        ("gl"    "global"     maplev--abbrev-hook 0)
+        ("inf"   "infinity"   maplev--abbrev-hook 0)
+        ("lib"   "libname"    maplev--abbrev-hook 0)
+        ("lo"    "local"      maplev--abbrev-hook 0)
+        ("ma"    "matrix"     maplev--abbrev-hook 0)
+        ("npf"   "nprintf"    maplev--abbrev-hook 0)
+        ("null"  "NULL"       maplev--abbrev-hook 0)
+        ("pi"    "Pi"         maplev--abbrev-hook 0)
+        ("pnam"  "procname"   maplev--abbrev-hook 0)
+        ("pf"    "printf"     maplev--abbrev-hook 0)
+        ("remem" "remember"   maplev--abbrev-hook 0)
+        ("ret"   "RETURN"     maplev--abbrev-hook 0)
+        ("rlib"  "readlib"    maplev--abbrev-hook 0)
+        ("stext" "searchtext" maplev--abbrev-hook 0)
+        ("stxt"  "SearchText" maplev--abbrev-hook 0)
+        ("ta"    "table"      maplev--abbrev-hook 0)
+        ("th"    "then"       maplev--abbrev-hook 0)
+        ("trap"  "traperror"  maplev--abbrev-hook 0)
+        ("ty"    "type"       maplev--abbrev-hook 0)
+        ("user"  "userinfo"   maplev--abbrev-hook 0)
+        ("wh"    "while"      maplev--abbrev-hook 0)))
+    (setq abbrevs-changed ac)))
+
+(defun maplev-abbrev-help ()
+  "List the currently defined abbreviations."
+  (interactive)
+  (list-one-abbrev-table maplev-mode-abbrev-table "*Abbrevs*"))
+
+;;}}}
+;;{{{ Imenu support
+
+;; Index all the procedure assignments.  Other possiblities to index
+;; are global variable assignments, macros and aliases; however,
+;; selecting them is difficult.
+
+(defvar maplev-imenu-generic-expression
+  `(("Procedures" ,maplev--defun-begin-re 2)
+    ("Modules" ,(concat "^\\(" maplev--name-re "\\)"
+                          "[ \t\n]*:=[ \t\n]*"
+                          "module") 1)
+    ("Macros" ,(concat "^macro([ \t]*\\([^ \t=]*\\)") 1))
+  "Imenu expression for MapleV mode.  See `imenu-generic-expression'.")
+
+(defun maplev--imenu-goto-function (name position &rest ignore)
+  "Move point to POSITION.  Ignore NAME and IGNORE.
+This works with `folding-mode', but crudely.  Folding mode appears to
+have an error; `folding-goto-char' does not work reliably.  Until that
+is fixed the solution is to open the entire buffer."
+  (and (or (< position (point-min))
+           (> position (point-max)))
+       (widen))
+  (if folding-mode (folding-open-buffer))
+  (goto-char position))
+
+(defun maplev-add-imenu ()
+  "Add an imenu of Maple procedures."
+  (interactive)
+  (imenu-add-to-menubar "Index")
+  (menu-bar-mode 1))
+
+(defun maplev--imenu-create-index-function ()
+  "Create an index for `imenu'.
+Check whether `folding-mode' is active."
+  (if folding-mode (folding-open-buffer))
+  (imenu-default-create-index-function))
+
+;;}}}
+;;{{{ Buffer edit functions
+
+;; Does this work with folding-mode?
+(defun maplev-remove-trailing-spaces  ()
+  "Remove trailing spaces in the whole buffer."
+  (interactive)
+  (save-match-data
+    (save-excursion
+      (save-restriction
+        (widen)
+        (goto-char (point-min))
+        (while (re-search-forward "[ \t]+$" (point-max) t)
+          (replace-match "" nil nil))))))
+
+
+(defun maplev-goto-comment ()
+  "Move point just after comment character in line.
+If there is no comment character in the line, move point to end of line
+and return nil, otherwise return t."
+  (interactive)
+  (beginning-of-line)
+  (maplev--validate-indent-info)
+  (let ((state  (parse-partial-sexp
+                 (maplev--indent-info-point)
+                 (point)
+                 nil nil (maplev--indent-info-state))))
+    (nth 4 (parse-partial-sexp
+            (point)
+            (line-end-position)
+            nil nil state 'comment-stop))))
+
+(defun maplev-fill-paragraph (&optional justify)
+  "Like \\[fill-paragraph], but handles Maple comments.
+Assigned to `fill-paragraph-function'.  If any of the current line is
+a comment, fill the comment or the paragraph of it that point is in,
+preserving the comment's indentation and initial comment symbol.
+Prefix JUSTIFY means justify as well."
+  (interactive "*P")
+  (let (has-code      ; Non-nil if line contains code (possibly blank)
+        comment-fill-prefix)  ; Appropriate fill-prefix for a comment.
+
+    ;; Figure out what kind of comment we are looking at.
+
+    (save-excursion
+      (beginning-of-line)
+      (setq has-code (looking-at "[ \t]*[^ \t#]"))
+      (when (maplev-goto-comment)
+        (backward-char)
+        (looking-at "#+[\t ]*")
+        (setq comment-fill-prefix
+              (concat (if indent-tabs-mode
+                          (concat
+                           (make-string (/ (current-column) tab-width) ?\t)
+                           (make-string (% (current-column) tab-width) ?\ ))
+                        (make-string (current-column) ?\ ))
+                      (buffer-substring (match-beginning 0) (match-end 0))))
+        (save-restriction
+          (beginning-of-line)
+          (narrow-to-region
+           ;; Find the first line we should include in the region to fill.
+           (save-excursion
+             (while (and (zerop (forward-line -1))
+                         (looking-at "^[ \t]*#")))
+             ;; We may have gone too far.  Go forward again if there
+             ;; is no comment on this line.
+             (or (looking-at ".*#")
+                 (forward-line 1))
+             (point))
+           ;; Find the beginning of the first line past the region to fill.
+           (save-excursion
+             (while (progn (forward-line 1)
+                           (looking-at "^[ \t]*#")))
+             (point)))
+
+          ;; Lines with only comment characters on them
+          ;; can be paragraph boundaries.
+          (let* ((paragraph-start    (concat paragraph-start "\\|[ \t#]*$"))
+                 (paragraph-separate (concat paragraph-start "\\|[ \t#]*$"))
+                 (paragraph-ignore-fill-prefix nil)
+                 (fill-prefix comment-fill-prefix)
+                 (after-line (if has-code
+                                 (save-excursion
+                                   (forward-line 1) (point))))
+                 (end (progn
+                        (forward-paragraph)
+                        (or (bolp) (newline 1))
+                        (point)))
+                 ;; If this comment starts on a line with code,
+                 ;; include that line in the filling.
+
+                 (beg (progn (backward-paragraph)
+                             (if (eq (point) after-line)
+                                 (forward-line -1))
+                             (point))))
+            (fill-region-as-paragraph beg end
+                                      justify nil
+                                      (save-excursion
+                                        (goto-char beg)
+                                        (if (looking-at fill-prefix)
+                                            nil
+                                          (re-search-forward comment-start-skip)
+                                          (point)))))))
+      t))) ; return non-nil so fill-paragraph knows this succeeded
+
+;;}}}
+;;{{{ Info
+
+;; This must go elsewhere (in maplev-mode).
+
+(defun maplev-goto-info-node ()
+  "Go to the info node for maplev."
+  (interactive)
+  (require 'info)
+  (info "maplev"))
+
+;;}}}
+
+;;{{{ MapleV mode
+
+;;{{{   Release
+
+(defsubst maplev--major-release ()
+  "Integer variable assigned the selected release of Maple."
+  (truncate (string-to-number maplev-release)))
+
+(defun maplev-set-release (&optional release)
+  "Assign the buffer local variable `maplev-release'.
+RELEASE is a key in `maplev-executable-alist', if not supplied then
+`maplev-default-release' is used. Set syntax table according to
+RELEASE. If in `maplev-mode' also refontify the buffer."
+  (interactive
+   (list (completing-read "Use Maple release: "
+                          (mapcar (lambda (item) (list (car item)))
+                                  maplev-executable-alist)
+                          nil t)))
+  (setq release (or release maplev-default-release))
+  ;; Invalid values of release are possible only due to an invalid value
+  ;; of maplev-default-release.
+  (unless (assoc release maplev-executable-alist)
+    (error "Invalid Maple release: %S" release))
+  (setq maplev-release release)
+  (cond ((memq major-mode '(maplev-mode maplev-cmaple-mode maplev-proc-mode))
+         (if (< (maplev--major-release) 5)
+             (set-syntax-table maplev-mode-4-syntax-table)
+           (set-syntax-table maplev-mode-syntax-table)))
+        ;; for consistency also maplev-help-mode
+        ((eq major-mode 'maplev-help-mode)
+         (set-syntax-table maplev-help-mode-syntax-table)))
+  (when (eq major-mode 'maplev-mode)
+    (maplev-reset-font-lock)
+    (maplev-mode-name)))
+
+;;}}}
+;;{{{   definition
+
+(defun maplev-mode ()
+  "Major mode for editing Maple code.
+
+\\[maplev-electric-tab] indents the current line.
+\\[maplev-indent-newline] indents the current line and inserts a new indented line.
+\\[maplev-newline-and-comment] inserts a newline and begins a flush left comment.
+
+\\[maplev-insert-assignment-operator] inserts `:=' with spaces at end of line.
+\\[maplev-template-proc] inserts a procedure template after querying for options.
+\\[maplev-template-module] inserts a module template after querying for options.
+\\[maplev-template-use-statement] inserts a use statement after querying for the expression sequence.
+
+There are functions and keys for indenting code, syntax checking \(via mint\),
+displaying Maple help pages and printing the source code of procedures from the
+Maple libraries.
+
+\\{maplev-mode-map}"
+  (interactive)
+  (kill-all-local-variables)
+  (use-local-map maplev-mode-map)
+  (setq major-mode 'maplev-mode)
+
+  ;; abbreviation
+  (setq local-abbrev-table maplev-mode-abbrev-table)
+
+  ;; paragraph filling
+  ;;
+  ;; The assignment to `paragraph-start' is copied from emacs-lisp.el.
+  ;; Note that because `page-delimiter' is, by default, "^\f", that
+  ;; is, `^L' anchored to the beginning of the line, the assignment to
+  ;; `paragraph-start' violates the explicit warning in the docstring
+  ;; about not anchoring this value.  Not a big deal.
+
+  (set (make-local-variable 'paragraph-start)         (concat page-delimiter "\\|$"))
+  (set (make-local-variable 'paragraph-separate)       paragraph-start)
+  (set (make-local-variable 'fill-paragraph-function) 'maplev-fill-paragraph)
+  (set (make-local-variable 'paragraph-ignore-fill-prefix) t)
+  (set (make-local-variable 'adaptive-fill-mode)       nil)
+  (set (make-local-variable 'auto-fill-inhibit-regexp) (concat "[ \t]*[^  \t#]"))
+
+  (set (make-local-variable 'beginning-of-defun-function) #'maplev-beginning-of-defun)
+  (set (make-local-variable 'end-of-defun-function)       #'maplev-end-of-defun)
+
+  (set (make-local-variable 'require-final-newline) t)
+
+  (auto-fill-mode (if maplev-auto-fill-comment-flag 1 0))
+  (setq auto-fill-function 'maplev-auto-fill)
+
+  ;; indentation
+  (set (make-local-variable 'indent-line-function)   'maplev-indent-line)
+  (set (make-local-variable 'indent-region-function) 'maplev-indent-region)
+  (set (make-local-variable 'tab-width)               maplev-indent-level)
+  (set (make-local-variable 'indent-tabs-mode)        nil)
+
+  (ad-activate 'fixup-whitespace)
+
+  ;; abbrev expansion
+  (abbrev-mode (if maplev-initial-abbrev-mode-flag 1 0))
+
+  ;; comments
+  (set (make-local-variable 'comment-start)            maplev-comment-start)
+;;  (if (< emacs-major-version 22)
+;;      (set (make-local-variable 'block-comment-start)      maplev-block-comment-start))
+  (set (make-local-variable 'comment-end)              "")
+  (set (make-local-variable 'comment-start-skip)       "#+[ \t]*")
+  (set (make-local-variable 'comment-column)           maplev-comment-column)
+  (set (make-local-variable 'comment-indent-function) 'maplev-comment-indentation)
+
+  ;; menubar (for Xemacs, GNU Emacs doesn't need this)
+  (and maplev-menu (easy-menu-add maplev-menu))
+
+  ;; imenu
+  (set (make-local-variable 'imenu-create-index-function)
+       #'maplev--imenu-create-index-function)
+  (set (make-local-variable 'imenu-default-goto-function)
+       'maplev--imenu-goto-function)
+  (set (make-local-variable 'imenu-generic-expression)
+       maplev-imenu-generic-expression)
+  (set (make-local-variable 'imenu-case-fold-search) nil)
+
+  ;; aligning rules
+
+  (when (featurep 'align)
+    (setq align-mode-rules-list maplev-align-rules-list)
+    (setq align-mode-exclude-rules-list maplev-align-exclude-rules-list))
+
+  ;; Font lock support: make these variables buffer-local
+  ;; so that we can change the decoration level
+  (make-local-variable 'font-lock-defaults)
+  (make-local-variable 'font-lock-maximum-decoration)
+
+  ;; Mint support
+  (make-local-variable 'maplev-mint--code-beginning)
+  (make-local-variable 'maplev-mint--code-end)
+
+  ;; Is this what one wants??
+  ;; (set (make-local-variable 'beginning-of-defun-function) #'(lambda () (maplev-proc-beginning 1 t)))
+  ;; (set (make-local-variable 'end-of-defun-function)       #'(lambda () (maplev-proc-end 1 t)))
+  ;; (set (make-local-variable 'add-log-current-defun-function)
+  ;;      #'maplev-current-defun-name) ;; not yet available
+
+  ;; Release support
+  (maplev-set-release)
+  ;; the file's local variables specs might change maplev-release
+  ;; xemacs version of make-local-hook returns t, not the hook. (JR)
+  ;; make-local-hook is obsolete in GNU emacs 21.1
+  ;;(make-local-hook 'hack-local-variables-hook)
+  (add-hook 'hack-local-variables-hook 'maplev-mode-name nil t)
+
+  (if maplev-buttonize-includes-flag (maplev-buttonize-includes))
+  (if maplev-load-config-file-flag (maplev-load-config-file))
+
+  ;; Set hooks
+  (if maplev-clean-buffer-before-saving-flag
+      (add-hook 'local-write-file-hooks 'maplev-remove-trailing-spaces))
+  ;;(make-local-hook 'before-change-functions)
+  (add-hook 'before-change-functions 'maplev--before-change-function nil t)
+  (run-hooks 'maplev-mode-hook))
+
+(defun maplev-mode-name ()
+  "Set `mode-name' in `maplev-mode' according to `maplev-release'."
+  (setq mode-name (format "Maple %s" maplev-release)))
+
+;;}}}
+
+;;}}}
+
+;;{{{ Electric functions
+
+(defun maplev-indent-newline ()
+  "Indent current line, insert a newline and indent the new line.
+Current line is not indented if it is a comment.  Remove trailing
+whitespace."
+  (interactive "*")
+  (or (maplev--comment-line-indentation) ; nil if a comment
+      (maplev-indent-line))
+  (delete-horizontal-space)             ; remove trailing whitespace
+  (newline)
+  (maplev-indent-line))
+
+(defun maplev-insert-assignment-operator ()
+  "Insert the Maple assignment operator after last nonwhite character."
+  (interactive "*")
+  (end-of-line)
+  (skip-chars-backward " \t")
+  (delete-region (point) (line-end-position))
+  (insert maplev-assignment-operator))
+
+(defun maplev-electric-tab ()
+  "Indent the current line."
+  (interactive "*")
+  (maplev-indent-line))
+
+(defun maplev-newline-and-comment ()
+  "Insert a newline and start a new comment line.
+If the current line is a code line, the comment is set flush left,
+otherwise it is aligned with the previous code line."
+  (interactive "*")
+  (newline)                             ; should we indent?
+  (let ((indent (maplev--comment-line-indentation -1)))
+    (and indent (indent-to indent)))
+  (insert maplev-block-comment-start)
+  )
+
+
+(defun maplev--comment-line-indentation (&optional n)
+  "Return the indentation of a Maple comment line, nil if not a comment line.
+Optionally move N lines forward before testing.  Point is not affected."
+  (save-excursion
+    (forward-line (or n 0))
+    (and (looking-at "^[ \t]*#") (current-indentation))))
+
+(defun maplev-untab ()
+  "Delete backwards to previous tab stop."
+  (interactive "*")
+  (backward-delete-char-untabify
+   (let ((ind (% (current-column) maplev-indent-level)))
+     (and (= ind 0) (setq ind maplev-indent-level))
+     (if (> ind (current-column))
+         (current-column)
+       ind))))
+
+;;}}}
+;;{{{ Interactive functions
+
+(defun maplev--beginning-of-defun-pos (&optional top n)
+  "Return character position of beginning of previous defun.  If
+optional argument TOP is non-nil, search for top level defun.  With
+optional argument N, do it that many times.  Negative argument -N
+means search forward to Nth preceding end of defun.  Return nil if
+search fails."
+  (let ((regexp (if top maplev--top-defun-begin-re maplev--defun-begin-re))
+        pos)
+    (setq n (or n 1))
+    (save-excursion
+      (cond ((> n 0)
+             (and (setq pos 
+                        ;; Assign pos the position of the previous beginning statement.
+                        ;; Because point could be in the middle of the statement,
+                        ;; first search backwards, then forwards.  If the beginning position
+                        ;; of the forwards search is before the original point (orig),
+                        ;; then use it, otherwise use the beginning position of the backwards search.
+                        (let* ((orig (point))
+                               (beg (maplev--re-search-backward regexp nil 'move)))
+                          (if beg (goto-char (match-end 0)))
+                          (or (and (maplev--re-search-forward regexp nil t)
+                                   (< (setq pos (match-beginning 0)) orig)
+                                   pos)
+                              beg)))
+                  ;; If n=1 then pos is the character position,
+                  (if (= n 1)
+                      pos
+                    ;; otherwise, search backwards n-1 times.  
+                    ;; Because we are starting at the end of a defun,
+                    ;; we don't have to do the backwards search.
+                    (goto-char pos)
+                    (maplev--re-search-backward regexp nil t (1- n)))))
+            ((< n 0)
+             (and (maplev--re-search-backward regexp nil t n)
+                  (match-beginning 0)))
+            ((point))))))
+
+(defun maplev--end-of-defun-pos (&optional top n)
+  "Return character position of next end of defun.  If optional
+argument TOP is non-nil, search for top level defun.  With optional
+argument N, do it that many times.  Negative argument -N means search
+back to Nth preceding end of defun.  Return nil if search fails."
+
+  ;; The search algorithm is asymmetric with respect to direction.
+  ;; Searching backwards (-N) for an end of defun is easy, just search
+  ;; and move to the end of the match.  Searching forward is more
+  ;; complicated because point could lie within an end statement.
+
+  (let ((regexp (if top maplev--top-defun-end-re maplev--defun-end-re))
+        pos)
+    (setq n (or n 1))
+    (save-excursion
+      (cond ((> n 0)
+             (and (setq pos 
+                        ;; Assign pos the position of the next end statement.
+                        ;; Because point could be in the middle of the statement,
+                        ;; first search forward, then backwards.  If the end position
+                        ;; of the backwards search is past the original point (orig),
+                        ;; then use it, otherwise use the end position of the forward search.
+                        (let* ((orig (point))
+                               (end (maplev--re-search-forward regexp nil 'move)))
+                          (if end (goto-char (match-beginning 0)))
+                          (or (and (maplev--re-search-backward regexp nil t)
+                                   (> (setq pos (match-end 0)) orig)
+                                   pos)
+                              end)))
+                  ;; If n=1 then pos is the character position,
+                  (if (= n 1)
+                      pos
+                    ;; otherwise, search forward n-1 times.  
+                    ;; Because we are starting at the end of a defun,
+                    ;; we don't have to do the backwards search.
+                    (goto-char pos)
+                    (maplev--re-search-forward regexp nil t (1- n)))))
+            ((< n 0)
+             (and (maplev--re-search-forward regexp nil t n)
+                  (match-end 0)))
+            ((point))))))
+
+(defun maplev-beginning-of-defun (&optional n)
+  "Move point backward to the beginning of defun.  With optional
+argument N, move to the beginning of the Nth preceding defun.
+Negative argument -N means move forward to the end of the Nth
+following defun."
+  (interactive)
+  (setq n (or n 1))
+  (goto-char (or (maplev--beginning-of-defun-pos nil n)
+                 (if (> n 0) (point-min) (point-max)))))
+       
+(defun maplev-end-of-defun (&optional n)
+  "Move point forward to the end of defun.  With optional argument N,
+move to the end of the Nth following defun.  Negative argument -N
+means move backwards to the end of the Nth preceding defun."
+  (interactive)
+  (setq n (or n 1))
+  (goto-char (or (maplev--end-of-defun-pos nil n)
+                 (if (> n 0) (point-max) (point-min)))))
+
+(defun maplev-mark-defun ()
+  "Put mark at end of this defun, point at beginning.
+The defun marked is the one that contains point."
+  (interactive)
+  (push-mark (point))
+  (beginning-of-line)
+  (if (looking-at maplev--defun-begin-re) (goto-char (match-end 0)))
+  (let ((count 1)
+        (regexp (concat "\\(" maplev--defun-begin-re "\\)\\|\\(?:" maplev--defun-end-re "\\)")))
+    (while (and (/= count 0)
+                (re-search-forward regexp nil 'move))
+      (setq count (+ count (if (match-beginning 1) 1 -1))))
+    (forward-line)
+    (push-mark (point) nil t)
+    (when (= count 0)
+      (goto-char (match-beginning 0))
+      (setq count -1))
+    (while (and (/= count 0)
+                (re-search-backward regexp nil 'move))
+      (setq count (+ count (if (match-beginning 1) 1 -1))))))
+
+(defun maplev-current-defun ()
+  "Return a list with buffer positions of begin and end of current defun."
+  (save-excursion
+    (maplev-mark-defun)
+    (list (point) (mark))))
+
+(defun maplev-narrow-to-defun ()
+  "Make text outside current defun invisible."
+  (interactive)
+  (widen)
+  (let ((reg (maplev-current-defun)))
+    (narrow-to-region (car reg) (nth 1 reg))))
+
+
+(defun maplev-what-proc (&optional nodisplay)
+  "Display and return the name of the current procedure.
+If optional NODISPLAY is non-nil, just return the string."
+  (interactive)
+  (save-restriction
+    (save-excursion
+      (widen)
+      (end-of-line)
+      (maplev-beginning-of-defun)
+      (re-search-forward maplev--assignment-re)
+      (let ((proc (match-string-no-properties 1)))
+      (if nodisplay
+          proc
+        (message proc))))))
+
+;;; stuff used by mint
+
+(defun maplev--re-search-forward (regexp &optional bound noerror count)
+  "Search forward from point for regular expression REGEXP.
+This function is like re-search-forward, but comments are ignored.
+Optional arguments BOUND, NOERROR, and COUNT have the same meaning
+as in `re-search-forward'."
+  ;; This approach gets confused by a comment inside the match
+  ;; (e.g., when REGEXP can match more than one line).
+  ;; Therefore it's better to break complex REGEXP's apart
+  ;; and handle the items seperately.
+  (if (not count) (setq count 1))
+  (let ((dir (if (< count 0) -1 1))
+        (pos (point))
+        case-fold-search)
+    (while (and (not (zerop count)) pos)
+      (setq pos (re-search-forward regexp bound noerror dir))
+      (while (and (nth 4 (parse-partial-sexp (maplev-safe-position) (point)))
+                  (setq pos (re-search-forward regexp bound noerror dir))))
+      (setq count (- count dir)))
+    pos))
+      
+(defun maplev--re-search-backward (regexp &optional bound noerror count)
+  "Search backward from point for regular expression REGEXP.
+This function is like re-search-backward, but comments are ignored.
+Optional arguments BOUND, NOERROR, and COUNT have the same meaning
+as in `re-search-backward'."
+  ;; See maplev--re-search-forward.
+  (if (not count) (setq count 1))
+  (let ((dir (if (< count 0) -1 1))
+        (pos (point))
+        case-fold-search)
+    (while (and (not (zerop count)) pos)
+      (setq pos (re-search-backward regexp bound noerror dir))
+      (while (and (nth 4 (parse-partial-sexp (maplev-safe-position) (point)))
+                  (setq pos (re-search-backward regexp bound noerror dir))))
+      (setq count (- count dir)))
+    pos))
+
+(defun maplev-safe-position (&optional to)
+  "Search for safe buffer position before point \(a position not in a comment\).
+Optional arg TO initializes the search. It defaults to point"
+  (unless to (setq to (point)))
+  (save-excursion
+    (save-match-data
+      (goto-char to)
+      (while (and (= 0 (forward-line -1))
+                  (looking-at "#")))
+      (point))))
+
+(defun maplev--scan-lists (count &optional from)
+  "Scan COUNT lists. Optional arg FROM defaults to position of point.
+Returns the character number of the position thus found."
+  (if (not from) (setq from (point)))
+  (let ((parse-sexp-ignore-comments t))
+    (scan-lists from count 0)))
+
+(defun maplev-delete-whitespace (&optional back)
+  "Delete whitespace characters plus empty comments at point.
+If optional arg BACK is non-nil, delete whitespace characters before point."
+  ;; It would be nice to have a function looking-at-backward,
+  ;; but there is nothing like that. (Guess why :-)
+  (if back (let ((pos (point)))
+             (skip-chars-backward " \t\n")
+             (delete-region pos (point)))
+    (save-match-data
+      ;; Is this regexp too aggressive?
+      (if (looking-at "\\([ \t\n]\\|\\(#[ \t]*$\\)\\)*")
+          (delete-region (match-beginning 0) (match-end 0))))))
+
+(defun maplev--statement-terminator ()
+  "Buffer position immediately following next non-comment semicolon or
+colon that is not part of a double colon, colon-dash, or colon-equals."
+  (save-excursion
+    (maplev--re-search-forward "[^:]\\(;\\|:[^-:=]\\)" nil t)
+    (+ 1 (match-beginning 1))))
+
+(defun maplev--goto-declaration (keyword)
+  "Move point to the start of the KEYWORD declaration in a Maple procedure.
+Return nil if there no such statement.  Point must be to the right of
+the closing parenthesis in the formal parameter list."
+  (let ((bound (save-excursion
+                 (maplev--re-search-forward maplev--defun-re
+                                            ;; (maplev-end-of-proc) 'move)
+                                            (maplev--end-of-defun-pos) 'move)
+                 (point))))
+    (if (save-excursion
+          (maplev--re-search-forward
+           (concat "\\<" keyword "\\>") bound t))
+        (goto-char (match-beginning 0)))))
+
+
+(defun maplev-add-declaration-one-line (keyword var)
+  "To the current procedure's KEYWORD declaration add VAR.
+If necessary, add a KEYWORD statement.  Point must be after the closing
+parenthesis of the procedure's argument list."
+  (save-excursion
+    (if (maplev--goto-declaration keyword)
+        (let ((end (maplev--statement-terminator)))
+          (if maplev-alphabetize-declarations-p
+              (progn
+                (forward-word)
+                (while (and (< (point) end)
+                            (looking-at (concat "\\s-*\\(" maplev--symbol-re "\\) *,?"))
+                            (string< (match-string-no-properties 1) var))
+                  ;; Move over symbol and, if there, comma.  For now
+                  ;; assume that the symbols do not have
+                  ;; types---including types in-line seems bad form.
+                  ;; Moving across a type is fairly tricky.
+                  (goto-char (match-end 0)))
+                (if (looking-at " *;")
+                    (insert (format ", %s" var))
+                  (insert (format " %s," var))))
+            (goto-char end)
+            (backward-char)
+            (insert "," (make-string maplev-variable-spacing ?\ ) var)))
+      (let (stay)
+        ;; Declarations are ordered: local, global, export
+        (if (maplev--goto-declaration "local")
+            (setq stay (goto-char (maplev--statement-terminator))))
+        (if (maplev--goto-declaration "global")
+            (setq stay (goto-char (maplev--statement-terminator))))
+        ;; Position point and text in preparation for inserting a
+        ;; declaration statement.
+        (if (not (looking-at "[ \t]*\\(#.*\\)?$")) ; More code on line?
+            (just-one-space)      ; Then insert declaration inbetween.
+          (forward-line)            ; Else move to the next code line.
+          (unless stay                 ; Keep moving if we not already
+            (while (looking-at "[ \t]*#") ; have a declaration.
+              (forward-line)))))
+      ;; Insert the declaration statement KEYWORD VAR ; at point.
+      ;; If point is at beginning of line, insert a newline at end.
+      ;; NOTE: It might be better to look whether there is any following text.
+      (let ((new-line (bolp)))
+        (insert keyword " " var "; ")
+        (when new-line
+          (newline)
+          (forward-line -1)))
+      (maplev-indent-line))))
+
+(defun maplev-add-declaration-leading-comma (keyword var)
+  "To the current procedure's KEYWORD declaration add VAR.
+If necessary, add a KEYWORD statement.  Point must be after the
+closing parenthesis of the procedure's argument list.  Optional
+TYPE specifies the declared type of VAR.  The string
+`maplev-var-declaration-symbol' is used as the declaration
+symbol; it is inserted between VAR and TYPE.
+
+If `maplev-alphabetize-declarations-p' is non-nil, VAR is
+inserted alphabetically into the sequence of existing
+declarations, otherwise it is inserted at the end."
+  (save-excursion
+    (if (maplev--goto-declaration keyword)
+        (let ((end (maplev--statement-terminator)))
+          (if maplev-alphabetize-declarations-p
+              (progn
+                (forward-word)
+                (while (and (< (point) end)
+                            (looking-at (concat "\\s-*\\(?:, \\)?\\(" maplev--symbol-re "\\)"))
+                            (string< (match-string-no-properties 1) var))
+                  (forward-line))
+                (if (looking-at "\\s-*[,;]")
+                    (progn
+                      (insert (format ", %s" var))
+                      (maplev-indent-newline))
+                  (insert (format " %s" var))
+                  (maplev-indent-newline)
+                  (insert ", ")))
+            ;; Insert `, VAR' before terminator.
+            (goto-char end)
+            (forward-line 0)
+            (insert (format ", %s" var))
+            (maplev-indent-newline)))
+      (let (stay)
+        ;; Declarations are ordered: local, global, export
+        (if (maplev--goto-declaration "local")
+            (setq stay (goto-char (maplev--statement-terminator))))
+        (if (maplev--goto-declaration "global")
+            (setq stay (goto-char (maplev--statement-terminator))))
+        ;; Position point and text in preparation for inserting a
+        ;; declaration statement.
+        (if (not (looking-at "[ \t]*\\(#.*\\)?$")) ; More code on line?
+            (just-one-space)      ; Then insert declaration inbetween.
+          (forward-line)          ; Else move to the next code line.
+          (unless stay            ; Keep moving if we not already
+            (while (looking-at "[ \t]*#") ; have a declaration.
+              (forward-line)))))
+      ;; Insert the declaration statement KEYWORD VAR\n; at point.
+      (insert (format " %s %s" keyword var))
+      (maplev-indent-newline)
+      (insert ";")
+      (maplev-indent-newline))))
+
+(defun maplev-add-declaration-trailing-comma (keyword var)
+  "To the current procedure's KEYWORD declaration add VAR.
+If necessary, add a KEYWORD statement.  Point must be after the
+closing parenthesis of the procedure's argument list.  Optional
+TYPE specifies the declared type of VAR.  The string
+`maplev-var-declaration-symbol' is used as the declaration
+symbol; it is inserted between VAR and TYPE.
+
+If `maplev-alphabetize-declarations-p' is non-nil, VAR is
+inserted alphabetically into the sequence of existing
+declarations, otherwise it is inserted at the end."
+  (save-excursion
+    (if (maplev--goto-declaration keyword)
+        (let ((end (maplev--statement-terminator)))
+          (if maplev-alphabetize-declarations-p
+              (progn
+                (forward-line)
+                (while (and (< (point) end)
+                            (looking-at (concat "\\s-*\\(" maplev--symbol-re "\\)"))
+                            (string< (match-string-no-properties 1) var))
+                  (forward-line))
+                (if (< (point) end)
+                    (insert (format "%s," var))
+                  (forward-line -1)
+                  (re-search-forward ";" (line-end-position))
+                  (replace-match ",")
+                  (forward-line)
+                  (insert (format "%s;" var)))
+                (maplev-indent-newline))
+            ;; Replace terminator with comma.
+            ;; Preserve comments following terminator.
+            (goto-char end)
+            (delete-char -1)
+            (insert ",")
+            (end-of-line)
+            ;; Insert VAR with terminator.
+            (newline)
+            (insert (format "%s;" var))
+            (maplev-indent-line)))
+      (let (stay)
+        ;; Declarations are ordered: local, global, export
+        (if (maplev--goto-declaration "local")
+            (setq stay (goto-char (maplev--statement-terminator))))
+        (if (maplev--goto-declaration "global")
+            (setq stay (goto-char (maplev--statement-terminator))))
+        ;; Position point and text in preparation for inserting a
+        ;; declaration statement.
+        (if (not (looking-at "[ \t]*\\(#.*\\)?$")) ; More code on line?
+            (just-one-space)      ; Then insert declaration inbetween.
+          (forward-line)          ; Else move to the next code line.
+          (unless stay            ; Keep moving if we not already
+            (while (looking-at "[ \t]*#") ; have a declaration.
+              (forward-line)))))
+      ;; Insert the declaration statement KEYWORD VAR ; at point.
+      ;; If point is at beginning of line, insert a newline at end.
+      ;; NOTE: It might be better to look whether there is any following text.
+      (if (bolp)
+          (progn
+            (insert keyword)
+            (maplev-indent-line)
+            (newline)
+            (insert (format "%s;" var))
+            (newline)
+            (forward-line -1))
+        (insert (format " %s %s;" keyword var) ))
+      (maplev-indent-line))))
+
+(defun maplev-add-declaration (keyword var &optional type)
+  "To the KEYWORD declaration of current procedure, add VAR.
+If non-nil, optional TYPE is catenated to VAR and
+`maplev-var-declaration-symbol'.  The function assigned to
+`maplev-add-declaration-function' does the work."
+  (funcall maplev-add-declaration-function keyword
+           (if type
+               (concat var maplev-var-declaration-symbol type)
+             var)))
+
+(defun maplev-add-local-variable (var &optional type)
+  "Add VAR to the current procedure's local statement.
+Interactively, VAR defaults to identifier point is on."
+  (interactive (list (maplev-ident-around-point-interactive
+                      "Local variable")
+                     ;; Query type unless all declarations go on one line.
+                     ;; It seems bad from to use types one one-line; regardless,
+                     ;; `maplev-add-declaration-one-line' currently does not
+                     ;; handle types.
+                     (unless (equal maplev-add-declaration-function 'maplev-add-declaration-one-line)
+                       (let ((type (read-string
+                                    "Type (empty for no type): "
+                                    nil
+                                    maplev--declaration-history)))
+                         (if (equal "" type)
+                             nil
+                           type)))))
+  (maplev-add-variable "local" var type))
+                                 
+
+(defun maplev-add-global-variable (var)
+  "Add VAR to the current procedure's local statement.
+Interactively, VAR defaults to identifier point is on."
+  (interactive (list (maplev-ident-around-point-interactive
+                      "Global variable")))
+  (maplev-add-variable "global" var))
+
+(defun maplev-add-export-variable (var)
+  "Add VAR to the current module's export statement.
+Interactively, VAR defaults to identifier point is on."
+  (interactive (list (maplev-ident-around-point-interactive
+                      "Exported variable")))
+  (maplev-add-variable "export" var))
+
+(defun maplev-add-variable (keyword var &optional type)
+  "To the current procedure's KEYWORD declaration add VAR."
+  (save-excursion
+    (maplev-beginning-of-defun)
+    (goto-char (maplev--scan-lists 1))
+    (maplev-add-declaration keyword var type)))
+
+(defun maplev-delete-declaration (keyword vars &optional leave-one)
+  "From the KEYWORD declaration delete occurrences of VARS.
+VARS must be eiter a string or a list of strings. If optional
+argument LEAVE-ONE is non-nil, then one occurrence of VARS is left.
+The entire statement is deleted if it is left with no variables."
+  (save-excursion
+    (when (maplev--goto-declaration keyword)
+      (maplev-delete-vars (point) (maplev--statement-terminator)
+                          vars leave-one)
+      ;; remove entire KEYWORD statement, if empty
+      (let (case-fold-search)
+        (when (looking-at (concat keyword "[ \t\n]*[;:]\\([ \t#]*$\\)?"))
+          (delete-region (match-beginning 0) (match-end 0))
+          (maplev-delete-whitespace t))))))
+
+(defun maplev-delete-vars-old (start end vars &optional leave-one)
+  "In region between START and END delete occurrences of VARS.
+VARS must be either a string or a list of strings. If optional
+argument LEAVE-ONE is non-nil, then one occurrence of VARS is left."
+  (let (case-fold-search lo)
+    (save-excursion
+      (save-restriction
+        (narrow-to-region start end)
+        (if (stringp vars) (setq vars (list vars)))
+        (while vars
+          (setq lo leave-one)
+          (goto-char (point-min))
+          (while (maplev--re-search-forward
+                  (concat "\\<" (car vars) "\\>"
+                          ;; Add optional type declarations.  I don't know
+                          ;; how to make this robust, a type
+                          ;; declaration can have commas and closing
+                          ;; parentheses.
+                          "\\(\\s-*::\\s-*[^,:;)]+\\)?")
+                  nil t)
+            (if lo
+                (setq lo nil)
+              (delete-region (match-beginning 0) (match-end 0))
+              (maplev-delete-whitespace)
+              (when (or (maplev--re-search-forward  "," nil t)
+                        (maplev--re-search-backward "," nil t))
+                (delete-region (match-beginning 0) (match-end 0))
+                (maplev-delete-whitespace))))
+          (setq vars (cdr vars)))))))
+
+(defun maplev-delete-vars (start end vars &optional leave-one)
+  "In region between START and END delete occurrences of VARS.
+VARS must be either a string or a list of strings. If optional
+argument LEAVE-ONE is non-nil, then one occurrence of VARS is left."
+  (let ((parse-sexp-ignore-comments)
+        case-fold-search lo )
+    (save-excursion
+      (save-restriction
+        (narrow-to-region start end)
+        (if (stringp vars) (setq vars (list vars)))
+        (while vars
+          (setq lo leave-one)
+          (goto-char (point-min))
+          (while (maplev--re-search-forward
+                  (concat "\\<" (car vars) "\\>")
+                  nil t)
+            (if lo
+                (setq lo nil)
+              (delete-region (match-beginning 0) (match-end 0))
+              (maplev-delete-whitespace)
+
+              ;; Remove optional type declaration
+              
+              (when (looking-at "::\\s-*") 
+                ;; Skip past type declaration operator (::)
+                ;; so looking-at won't match them.
+                (goto-char (match-end 0)) 
+                (delete-region (match-beginning 0)
+                               (progn 
+                                 ;; Unless looking at an argument separator,
+                                 ;; statement terminator, or closing
+                                 ;; parenthesis, or at end of buffer, move
+                                 ;; forward over a balanced expression.
+                                 ;;
+                                 ;; This nees modification to handle comments,
+                                 ;; esp. with leading commas.
+                                 (while (and (not (looking-at "[ \t\f\n]*[,;:#)]"))
+                                             (/= (point) (point-max)))
+                                   (forward-sexp))
+                                 (point))))
+              ;; Remove separating comma
+              (when (or (maplev--re-search-backward "," nil t)
+                        (maplev--re-search-forward  "," nil t))
+                (delete-region (match-beginning 0) (match-end 0))
+                (maplev-delete-whitespace))))
+          (setq vars (cdr vars)))))))
+
+;;}}}
+
+;;{{{ Folding functions
+
+(with-no-warnings
+  (defun maplev-fold-proc ()
+    "Add editor fold marks around the procedure at point.
+The name of the procedure is inserted into the title of the fold."
+    (interactive)
+    (let ((proc (maplev-what-proc 'nodisplay)))
+      (maplev-mark-defun)
+      (folding-fold-region (point) (mark))
+      (insert (concat " " proc))
+      (folding-shift-out))))
+  
+;;}}}
+
+;;{{{ Movement functions
+
+(defconst maplev--operator-re
+  (concat "\\(?:"
+          (regexp-opt
+           '(":-"
+             "||"
+             "::"
+             "!"
+             "^" "@@"
+             "." "*" "&*" "/" "@" "intersect"
+             "mod"
+             "+" "-" "union" "minus"
+             ".." "subset"
+             "<" "<=" ">" ">=" "=" "<>" "in"
+             "$"
+             "not"
+             "and"
+             "or"
+             "xor"
+             "implies"
+             "->"
+             ;; ","
+             "assuming"
+             ;; ":="
+             ))
+          ;; neutral operators
+          "\\|&\\(?:[~!@$^*-+=\"<>,./?]+\\|[a-zA-Z_][a-zA-Z_0-9]*\\)"
+          "\\)")
+  "Regular expression matching a Maple operator."
+  )
+
+(defconst maplev--number-re
+  "\\=[+-]?\\(?:[0-9]+\\(\\.[0-9]*\\)?\\|\\.[0-9]+\\)\\(?:[Ee][+-]?[0-9]*\\)?"
+  "Regular expression matching a number.  This is slightly too aggressive,
+it incorrectly matches, d.Ed, which is invalid.")
+
+(defconst maplev--expr-re
+  (concat "\\s-*"
+          "\\(?:"
+          maplev--operator-re
+          "\\|"
+          maplev--number-re
+          "\\|"
+          maplev--symbol-re
+          "\\|"
+          maplev--string-re
+          "\\)"
+          "\\s-*"
+          )
+  "Regular expression to match a partial expression.")
+
+(defun maplev-forward-expr ()
+  "Move point forward over a complete expression."
+  (interactive)
+  (if
+      (cond
+       ((looking-at "\\s-*\\s(")
+        (forward-sexp)
+        t)
+       ((looking-at maplev--expr-re)
+        (goto-char (match-end 0)))
+       ((looking-at "\\s-*\\(?:#.*\\)?$")
+        (forward-line)))
+      (maplev-forward-expr)))
+
+;;}}}
+
+;;{{{ Miscellaneous
+
+(defun maplev-remove-dupes (list)
+  "Remove duplicates from a sorted assoc LIST."
+  (let (tmp-list head)
+    (while list
+      (setq head (pop list))
+      (unless (equal (car head) (car (car list)))
+        (push head tmp-list)))
+    (reverse tmp-list)))
+
+(defun maplev-minus (setA setB)
+  "Remove members of SETB from SETA."
+  (let (tmp head)
+    (while setA
+      (setq head (pop setA))
+      (unless (member head setB)
+	  (push head tmp)))
+    (reverse tmp)))
+
+;;}}}
+
+;;{{{ Templates
+
+(defun maplev--template-proc-module (function name args description)
+  "Insert a template for a Maple FUNCTION \(\"proc\" or \"module\"\).
+Use NAME, ARGUMENTS, and DESCRIPTION. Move point to body of FUNCTION.
+
+If NAME equals \"\" then the function is anonymous,
+no assignment operator is inserted and the closing
+end statement is not terminated with a colon.
+
+ARGS are inserted as formal arguments in the function statement.
+
+If `maplev-insert-copyright-flag' is non-nil, then insert a copyright
+as an option statement.  Confirmation is required for an anonymous
+function.
+
+Unless DESCRIPTION equals \"\" it is inserted as a description statement.
+
+If `maplev-comment-end-flag' is non-nil, and the function is not
+anonymous, then NAME is inserted as a comment following the closing
+end statement.  Point is moved to the start of the function body."
+  (let ((fname (not (string= name ""))))
+    ;; Insert assignment if function has a name
+    (when fname
+      (setq name (maplev--string-to-name name))
+      (insert name " := "))
+    (insert function
+            (make-string maplev-variable-spacing ?\ )
+            "(" args ")")          ; Insert function, with formal args
+
+    ;; Copyright notice
+    (when (and maplev-insert-copyright-flag
+               (or fname (y-or-n-p "Insert copyright? ")))
+      (insert "\noption `Copyright (C) "
+              (format-time-string "%Y" (current-time))
+              " by " maplev-copyright-owner ". All rights reserved.`;"))
+
+    ;; description
+    (unless (string= description "")
+      (insert "\ndescription " maplev-description-quote-char
+              description maplev-description-quote-char ";"))
+
+    (insert "\n\nend")
+    (when fname
+      (insert ":")
+      (if maplev-comment-end-flag
+          (insert maplev-template-end-comment name)))
+    (forward-line -1)                   ; Move point to start of body
+    ;; bug in maplev-current-defun:
+    ;; it doesn't work yet with anonymous procedures
+    (when fname (maplev-indent-procedure))))
+
+(defun maplev-template-proc (name args description)
+  "Insert a template for a Maple procedure and move point to its body.
+Prompt for the NAME, ARGS, and DESCRIPTION.  See `maplev-template'."
+  (interactive "*sName (return for anonymous) \nsArguments: \nsDescription: ")
+  (maplev--template-proc-module "proc" name args description))
+
+(defun maplev-template-module (name args description)
+  "Insert a template for a Maple module and move point to its body.
+Prompt for the NAME, ARGUMENTS, and DESCRIPTION.  See `maplev-template'."
+  (interactive "*sName (return for anonymous) \nsArguments: \nsDescription: ")
+  (maplev--template-proc-module "module" name args description))
+
+(defun maplev-template-use-statement (exprseq)
+  "Insert a template for a Maple use statement and move point to its 
+first statement.  Prompt fo the EXPRSEQ."
+  (interactive "*sExpression Sequence: ")
+  (insert "use " exprseq " in")
+  (maplev-indent-newline)
+  (insert "\nend use")
+  (maplev-indent-line)
+  (forward-line -1)
+  (maplev-indent-line))
+
+;;}}}
+;;{{{ Completion
+
+;; Define functions for completing Maple symbols.
+;;
+;; It is easy enough to collect all the symbols defined in
+;; ?index/functions and ?index/packages.  However, we would really
+;; like to complete on the exports of particular Maple modules.  It is
+;; not practical, nor useful, to complete on all exports of all
+;; modules, not is it straightforward to provide intelligent
+;; completion, that is, inside a `use ' statement complete on
+;; the exports of .  A reasonable workaround is to provide a
+;; function that allows the user to add the exports of selected
+;; modules to the completion list.
+
+(defun maplev-add-exports-of-module-at-point (module)
+  "Add the exports of MODULE at point to `maplev-completion-alist'.
+The real work is done by `maplev-complete-on-module-exports'."
+  (interactive (list (maplev-ident-around-point-interactive
+                      "Complete on Maple exports of module")))
+  (maplev-complete-on-module-exports module))
+
+(defun maplev-complete-on-module-exports (module)
+  "Add the exports of MODULE to `maplev-completion-alist'."
+
+  ;; First, ensure that `maplev-completion-alist' is assigned.
+  (maplev--generate-initial-completion-alist)
+  (save-current-buffer
+    (set-buffer (maplev--cmaple-buffer))
+    (save-restriction
+      ;; Print each export of module on a separate line in a narrowed buffer.
+      (narrow-to-region (point-max) (point-max))
+      (maplev-cmaple--send-string 
+       (maplev--cmaple-process)
+       (concat "seq(lprint(e),e=exports(" module "));"))
+      (maplev-cmaple--wait 3)
+      ;; (while (maplev-cmaple--locked-p) (maplev--short-delay))
+      ;; Delete the input line.
+      (delete-region 
+       (goto-char (point-min))
+       (progn (forward-line) (point)))
+      ;; Check that no Maple error occurred.
+      ;; If so, assume that module is not an actual Maple module
+      ;; and print a temporary message at the bottom of the screen.
+      (if (looking-at "Error")
+          (progn
+            (ding)
+            (message "The argument `%s' is not a Maple module" module)
+            (sit-for 2))
+        ;; Initialize completions to those previously assigned
+        (let ((completions (car (cdr (assoc maplev-release maplev-completion-alist)))))
+          ;; Goto end of buffer and read upwards, a line at a time,
+          ;; adding it to the exports list.
+          (goto-char (point-max))
+          (while (zerop (forward-line -1))
+            (setq completions
+                  (cons (cons (buffer-substring-no-properties
+                               (point) (line-end-position))
+                              nil)
+                        completions)))
+          ;; Replace the completion alist.
+          (setcar (cdr (assoc maplev-release maplev-completion-alist)) 
+                  (maplev-remove-dupes
+                   (sort completions (lambda (a b) (string< (car a) (car b))))))))
+      ;; Delete the output from the cmaple buffer.
+      (delete-region (point-min) (point-max)))))
+
+(defun maplev--generate-initial-completion-alist ()
+  "Generate `maplev-completion-alist' from the index/function and
+index/package help pages.  If it already exists, do nothing."
+  (unless (assoc maplev-release maplev-completion-alist)
+
+    ;; To make it easy to pick out the package names from the
+    ;; index/package help page, set the interface variable
+    ;; `screenwidth' to infinity and save the original value in the
+    ;; elisp variable screenwidth.
+        
+    (let ((screenwidth (maplev-cmaple-direct 
+                        "lprint(interface('screenwidth'=infinity));" t))
+          completions)
+      (unwind-protect
+          (save-current-buffer
+            (set-buffer (get-buffer-create (maplev--help-buffer)))
+
+            ;; Process help node "index/function".
+            (maplev-cmaple--wait 3)
+            ;; (while (maplev-cmaple--locked-p) (maplev--short-delay))
+            (maplev-help-show-topic "index/function" t)
+            (maplev-cmaple--wait 3)
+            ;; (while (maplev-cmaple--locked-p) (maplev--short-delay))
+            (save-restriction
+              (narrow-to-region 
+               (re-search-forward "^    ")
+               (save-excursion (goto-char (point-max))
+                               (re-search-backward "See Also")))
+              (goto-char (point-max))
+              (while (forward-word -1)
+                (setq completions
+                      (cons (cons (buffer-substring-no-properties
+                                   (point)
+                                   (save-excursion (forward-word 1) (point)))
+                                  nil)
+                            completions))))
+
+            ;; Process help node "index/package".
+            ;; (while (maplev-cmaple--locked-p) (maplev--short-delay))
+            (maplev-cmaple--wait 3)
+            (maplev-help-show-topic "index/package" t)
+            ;; (while (maplev-cmaple--locked-p) (maplev--short-delay))
+            (maplev-cmaple--wait 3)
+            (save-restriction
+              (narrow-to-region 
+               (progn (re-search-forward "^    \\w" nil t) 
+                      (goto-char (match-beginning 0))) ; first package
+               (progn (re-search-forward "^-" nil t)
+                      (goto-char (match-beginning 0)))) ; bullets after packages
+              (goto-char (point-max))
+              ;; Assign a regular expression to match each package name;
+              ;; the name is matched by the first group in regexp.
+              (let ((regexp (concat 
+                             "^\\s-+"   ; whitespace at start of line
+                             "\\(" maplev--name-re "\\)"))) ; package name (first group)
+                (while (re-search-backward regexp nil 'move)
+                  (setq completions
+                        (cons (cons (buffer-substring-no-properties 
+                                     (match-beginning 1) (match-end 1))
+                                    nil)
+                              completions)))))
+            ;; Delete both help pages.
+            (maplev-history-delete-item)
+            ;; (while (maplev-cmaple--locked-p) (maplev--short-delay))
+            (maplev-cmaple--wait 3)
+            (maplev-history-delete-item))
+
+        ;; Assign `maplev-completion-alist'.  Sort the completions.
+        (setq completions (sort completions (lambda (a b) (string< (car a) (car b))))
+              maplev-completion-alist
+              (cons (cons maplev-release (list completions))
+                    maplev-completion-alist)))
+      ;; Restore the original interface screenwidth.
+      (maplev-cmaple-direct (concat "interface('screenwidth'=" screenwidth ");") t))))
+
+
+(defun maplev--completion (word predicate mode)
+  "Generate minibuffer completion using maple function names.
+For the meaning of args see Info node `(elisp)Programmed Completion'."
+  ;; Make sure we are using the correct value of maplev-release.
+  ;; (Inside the minibuffer maplev-release equals maplev-default-release.)
+  (let ((maplev-release maplev-completion-release))
+    (maplev--generate-initial-completion-alist)
+    (let ((possibilities (cadr (assoc maplev-release maplev-completion-alist))))
+      (cond ((eq mode t)
+             (all-completions word possibilities predicate))
+            ((not mode)
+             (try-completion word possibilities predicate))
+            ((eq mode 'lambda)
+             (assoc word possibilities))))))
+
+(defun maplev-complete-symbol (&optional prefix)
+  "Perform completion on maple symbol preceding point.
+Compare that symbol against `maplev-completion-alist'."
+  ;; Code borrowed from lisp-complete-symbol.
+  (interactive)
+  (let* ((end (point))
+	 (beg (save-excursion
+                (backward-sexp 1)
+                (point)))
+	 (pattern (buffer-substring-no-properties beg end))
+         (maplev-completion-release maplev-release)
+	 (completion (try-completion pattern 'maplev--completion)))
+    (cond ((eq completion t))
+	  ((null completion)
+	   (message "Can't find completion for \"%s\"" pattern)
+	   (ding))
+	  ((not (string= pattern completion))
+	   (delete-region beg end)
+	   (insert completion))
+	  (t
+	   (message "Making completion list...")
+	   (let ((list (sort (all-completions pattern 'maplev--completion)
+                             'string<)))
+	     (with-output-to-temp-buffer "*Completions*"
+	       (display-completion-list list)))
+	   (message "Making completion list...%s" "done")))))
+
+;;}}}
+
+;;{{{ Comments to Strings
+
+(defun maplev-comment-to-string-region (beg end)
+  "Convert indented comments to strings.
+The purpose of this is to embed comments as strings into the source
+so that, when using a debugger, the showstat output appears to
+be commented.  See `maplev-string-to-comment-region'."
+  (interactive "r")
+  (save-excursion
+    (goto-char beg)
+    (while (re-search-forward "^\\(\\s-+\\)\\(#.*\\)" end t)
+      (replace-match "\\1\"\\2\";"))))
+
+(defun maplev-string-to-comment-region (beg end)
+  "Convert strings back to comments.
+This is the inverse of `maplev-comment-to-string-region.'"
+  (interactive "r")
+  (save-excursion
+    (goto-char beg)
+    (while (re-search-forward "^\\(\\s-+\\)\"\\(#.*\\)\";$" end t)
+      (replace-match "\\1\\2"))))
+
+;;}}}
+
+;;{{{ Auto-fill
+
+(defun maplev-auto-fill ()
+  "Use this function when `auto-fill-mode' is active in Maple.
+If `maplev-auto-break-strings-flag' is non-nil, a string that exceeds
+the current column is automatically broken at whitespace, terminated
+with a double-colon, and begun again on the next line, with an indent."
+  (let ((fc (current-fill-column)))
+    (and fc (<= fc (current-column))
+	 (if (and
+	      maplev-auto-break-strings-flag
+	      (eq ?\" (nth 3 (parse-partial-sexp (line-beginning-position) (point)))))
+	     (maplev-auto-break-string)
+	   (do-auto-fill)))))
+
+(defun maplev-auto-break-string ()
+  "Auto-break a string.  Must be called where the string is to break.
+Inserts double-quote, then calls `mpldoc-indent-newline' to insert an
+indented newling.  A double-quote is inserted at the indentation point.
+If at the end of the line, a closing double-quote is also added and point
+moved to be before it."
+  (insert "\"")
+  (newline-and-indent)
+  (insert-char ?\" 1)
+  (when (eolp)
+    (insert-char ?\" 1)
+    (backward-char)))
+	   
+
+
+;;}}}
+
+
+;;{{{ Font lock
+
+(defvar maplev-preprocessor-face   'maplev-preprocessor-face
+  "*Face name for Maple preprocessor directives.")
+
+(defface maplev-preprocessor-face
+  '((((class grayscale) (background light)) (:foreground "LightGray" :bold t))
+    (((class grayscale) (background dark))  (:foreground "DimGray"   :bold t))
+    (((class color)     (background light)) (:foreground "dark orange"))
+    (((class color)     (background dark))  (:foreground "orange"))
+    (t (:bold t)))
+  "Font lock mode face used for Maple preprocessor directives."
+  :group 'maplev-faces)
+
+
+;;{{{   reserved words
+
+(defconst maplev--reserved-words-3
+  '("and"  "by"   "do"        "done"   "elif"
+    "else" "end"  "fi"        "for"    "from"
+    "if"   "in"   "intersect" "local"  "minus"
+    "mod"  "not"  "od"        "option" "options"
+    "or"   "proc" "quit"      "read"   "save"
+    "stop" "then" "to"        "union"  "while"
+    "description" "local" "global")
+  "List of reserved words for Maple V R3")
+
+(defconst maplev--reserved-words-4
+  maplev--reserved-words-3
+  "List of reserved words for Maple V4")
+
+(defconst maplev--reserved-words-5
+  maplev--reserved-words-3
+  "List of reserved words for Maple V5")
+
+(defconst maplev--reserved-words-6
+  (append '("break" "catch" "error" "export" "finally"
+            "in" "module" "next" "return" "try" "use")
+          maplev--reserved-words-5)
+  "List of reserved words for Maple 6")
+
+(defconst maplev--reserved-words-7
+  (append '("assuming" "implies" "subset" "xor")
+          maplev--reserved-words-6)
+  "List of reserved words for Maple 7")
+
+(defconst maplev--reserved-words-8
+  maplev--reserved-words-7
+  "List of reserved words for Maple 8")
+
+(defconst maplev--reserved-words-9
+  maplev--reserved-words-7
+  "List of reserved words for Maple 9")
+
+(defconst maplev--reserved-words-10
+  (append '("uses")
+          maplev--reserved-words-7)
+  "List of reserved words for Maple 10")
+
+(defconst maplev--reserved-words-11
+  maplev--reserved-words-10
+  "List of reserved words for Maple 11")
+
+(defconst maplev--reserved-words-12
+  maplev--reserved-words-10
+  "List of reserved words for Maple 12")
+
+(defconst maplev--reserved-words-13
+  maplev--reserved-words-10
+  "List of reserved words for Maple 13")
+
+(defconst maplev--reserved-words-14
+  maplev--reserved-words-10
+  "List of reserved words for Maple 14")
+
+(defconst maplev--reserved-words-15
+  maplev--reserved-words-10
+  "List of reserved words for Maple 15")
+
+(defconst maplev--reserved-words-16
+  maplev--reserved-words-10
+  "List of reserved words for Maple 16")
+
+(defconst maplev--reserved-words-alist
+  `((3 .  ,maplev--reserved-words-3)
+    (4 .  ,maplev--reserved-words-4)
+    (5 .  ,maplev--reserved-words-5)
+    (6 .  ,maplev--reserved-words-6)
+    (7 .  ,maplev--reserved-words-7)
+    (8 .  ,maplev--reserved-words-8)
+    (9 .  ,maplev--reserved-words-9)
+    (10 . ,maplev--reserved-words-10)
+    (11 . ,maplev--reserved-words-11)
+    (12 . ,maplev--reserved-words-12)
+    (13 . ,maplev--reserved-words-13)
+    (14 . ,maplev--reserved-words-14)
+    (15 . ,maplev--reserved-words-15)
+    (16 . ,maplev--reserved-words-16)
+   )
+  "Alist of Maple reserved words.  The key is the major release.")
+
+;;}}}
+
+(defconst maplev--deprecated-re
+  (eval-when-compile
+    (maplev--list-to-word-re
+     (list "fi" "od" "traperror" "linalg" "solvefor" "ERROR")))
+  "Regex of deprecated keywords and procedures.")
+
+(defconst maplev--special-words
+  (list "args" "nargs" "procname" "RootOf" "Float" "thismodule" "thisproc"
+	"_options" "_noptions" "_rest" "_nrest"
+	"_params" "_nparams" "_passed" "_npassed"
+	"_nresults" "static" )
+  "List of special words in Maple.")
+
+(defconst maplev--special-words-re
+    (maplev--list-to-word-re maplev--special-words)
+  "Regex of special words in Maple.")
+
+(defconst maplev--initial-variables
+  (list "Catalan" "true" "false" "FAIL" "infinity" "Pi" "gamma"
+	"integrate" "libname" "NULL" "Order" "printlevel" "lasterror" "lastexception"
+	"`mod`" "Digits" "constants" "undefined" "I"
+	"UseHardwareFloats"
+	"Testzero" "Normalizer" "NumericEventHandlers"
+	"Rounding" "`index/newtable`")
+  "List of global, environmental variables, and constants.")
+
+(defconst maplev--initial-variables-re
+    (maplev--list-to-word-re maplev--initial-variables)
+  "Regexp of global, environmental variables and constants.")
+
+(defconst maplev--preprocessor-directives-re
+  (eval-when-compile
+    (concat "^\\$\\("
+            (regexp-opt (list
+			 "define"
+			 "elif"
+			 "else"
+			 "endif"
+			 "file"
+			 "ifdef"
+			 "ifndef"
+			 "include"
+			 "undef"
+			 ))
+            "\\)"))
+  "Regex of preprocessor directives.")
+
+(defconst maplev--include-directive-re
+  "^\\(?:## \\)?\\$include\\s-+\\([<\"]\\)\\(.*\\)[>\"]"
+  "Regex of an include directive.  The first group matches
+the character used to delimit the file (either < or \").
+The second group matches the filename.")
+    
+
+;;{{{  builtins
+
+;; Currently the backquoted builtin functions are font-locked as
+;; quoted names rather than as builtin functions.  Fixing this
+;; requires pulling them out.
+
+(defconst maplev--builtin-types-alist
+  '((8. ("`::`" "`..`" "`!`"
+         "algebraic" "anyfunc" "anything" "atomic"
+         "boolean"
+         "complex" "constant" "cx_infinity" "cx_zero"
+         "embedded_axis" "embedded_imaginary" "embedded_real"
+         "equation" "even" "extended_numeric" "extended_rational"
+         "finite" "float" "fraction" "function"
+         "identical" "imaginary" "indexable" "indexed" "integer"
+         "list" "literal"
+         "module" "moduledefinition"
+         "name" "neg_infinity" "negative" "negint" "negzero"
+         "nonnegative" "nonnegint" "nonposint" "nonpositive"
+         "nonreal" "numeric" "odd"
+         "polynom" "pos_infinity" "posint" "positive" "poszero"
+         "procedure" "protected"
+         "radical" "range" "rational" "ratpoly" "real_infinity"
+         "realcons" "relation"
+         "sequential" "set" "sfloat" "specfunc" "string" "symbol"
+         "tabular" "uneval" "zppoly")))
+  "Alist of builtin Maple types.  Currently not used.")
+
+(defconst maplev--builtin-functions-3
+ '("`$`" "ERROR" "Im" "RETURN" "Re" "SearchText"
+   "abs" "addressof" "alias" "anames" "appendto" "array" "assemble" "assigned"
+   "callback" "cat" "coeff" "coeffs" "convert" "debugopts"
+   "degree" "diff" "disassemble" "divide"
+   "entries" "eval" "evalb" "evalf" "`evalf/hypergeom`" "evalhf" "evaln" "expand"
+   "frontend" "gc" "genpoly" "goto" "has" "hastype"
+   "icontent" "`if`" "igcd" "ilog10" "indets" "indices" "intersect" "`int/series`" "iquo" "irem" "isqrt"
+   "lcoeff" "ldegree" "length" "lexorder" "lprint"
+   "macro" "map" "max" "maxnorm" "member" "min" "`minus`" "modp" "modp1" "mods"
+   "nops" "normal" "numboccur" "numer" "op" "order" "parse" "pointto" "print" "printf" "protect"
+   "readlib" "readline" "searchtext" "select" "seq" "series" "sign" "sort" "sscanf" "ssystem" "subs" "subsop" "substring" "system" 
+   "table" "taylor" "tcoeff" "time" "traperror" "trunc" "type" 
+   "unames" "`union`" "unprotect" "userinfo" "words" "writeto" ))
+
+(defconst maplev--builtin-functions-4
+  (append  '("`*`" "`+`" "ASSERT" "DEBUG" "MorrBrilCull" "add" "attributes" "denom" "getuserinterface" "inner" "iolib" "kernelopts" "`kernel/transpose`" "map2" "mul" "setattribute" "setuserinterface" "typematch")
+	   (maplev-minus maplev--builtin-functions-3
+			 '("printf" "protect" "readline" "setattribute" "setuserinterface" "sscanf" "unprotect" "words"))))
+		      
+
+(defconst maplev--builtin-functions-5
+  (append '("`**`" "`<`" "`<=`" "`<>`" "`=`" "`>`" "`>=`" "`^`" "call" "crinterp" "define" "`evalf/hypergeom/kernel`" "hfarray" "timelimit")
+	  (remove "`evalf/hypergeom`" maplev--builtin-functions-4)))
+
+(defconst maplev--builtin-functions-6
+  (append '("||" "Array" "ArrayOptions" "CopySign" "Default0" "DefaultOverflow" "DefaultUnderflow" 
+	    "EqualEntries" "EqualStructure" "FromInert" "MPFloat" 
+	    "NextAfter" "NumericClass" "NumericEvent" "NumericEventHandler" "NumericStatus" "OrderedNE"
+	    "SFloatExponent" "SFloatMantissa" "Scale10" "Scale2" "TRACE" "ToInert" "Unordered" 
+	    "`and`" "bind" "call_external" "conjugate" "define_external" "`done`" "evalgf1" "exports" "frem" 
+	    "ilog2" "lhs" "modp2" "mvMultiply" "negate" "`not`" "`or`" "remove" "rhs" 
+	    "rtable" "rtableInfo" "rtable_indfns" "rtable_is_zero" "rtable_normalize_index" 
+	    "rtable_num_dims" "rtable_num_elems" "rtable_options" "rtable_scanblock" "rtable_sort_indices" 
+	    "selectremove" "`stop`" "streamcall" "unbind")
+	  (maplev-minus maplev--builtin-functions-5
+			   '("call" "define" "getuserinterface" "setuserinterface"))))
+		     
+
+(defconst maplev--builtin-functions-7
+ (append '("_treeMatch" "_unify" "_xml" "dlclose" "factorial" "`implies`" "`subset`" "`xor`")
+           maplev--builtin-functions-6))
+
+(defconst maplev--builtin-functions-8
+ (append '("_jvm" "_maplet" "andmap" "ormap")
+           maplev--builtin-functions-7))
+
+(defconst maplev--builtin-functions-9
+ (append '("`..`" "Normalizer" "UpdateSource" "gmp_isprime" "is_gmp" "isqrt" "`mod`" "piecewise" "reduce_opr" "rtable_eval" "rtable_zip")
+           maplev--builtin-functions-8))
+
+(defconst maplev--builtin-functions-10
+ (append '("`?()`" "`?[]`" "`{}`" "`[]`" "SDMPolynom" "overload" "rtable_convolution" "rtable_redim" "rtable_scale" "savelib")
+           maplev--builtin-functions-9))
+
+(defconst maplev--builtin-functions-11
+  maplev--builtin-functions-10)
+
+(defconst maplev--builtin-functions-12
+ (append '("Record" "rtable_size") maplev--builtin-functions-11))
+
+(defconst maplev--builtin-functions-13
+ (append '("`::`" "`~`") maplev--builtin-functions-12))
+
+(defconst maplev--builtin-functions-14
+ (append '("Object") maplev--builtin-functions-13))
+
+(defconst maplev--builtin-functions-15
+  (append '("assign" "numelems" "upperbound" "lowerbound") maplev--builtin-functions-14))
+
+(defconst maplev--builtin-functions-16
+  (append '("_hackwareToPointer") maplev--builtin-functions-15))
+
+(defconst maplev--builtin-functions-alist
+  `((3  . ,maplev--builtin-functions-3)
+    (4  . ,maplev--builtin-functions-4)
+    (5  . ,maplev--builtin-functions-5)
+    (6  . ,maplev--builtin-functions-6)
+    (7  . ,maplev--builtin-functions-7)
+    (8  . ,maplev--builtin-functions-8)
+    (9  . ,maplev--builtin-functions-9)
+    (10 . ,maplev--builtin-functions-10)
+    (11 . ,maplev--builtin-functions-11)
+    (12 . ,maplev--builtin-functions-12)
+    (13 . ,maplev--builtin-functions-13)
+    (14 . ,maplev--builtin-functions-14)
+    (15 . ,maplev--builtin-functions-15)
+    (16 . ,maplev--builtin-functions-16)
+ "Alist of Maple builtin funtions. The key is the major release."))
+
+;; (defconst maplev--builtin-functions-alist
+;;  '((3 .  ("`$`"                                                                                                                                                                                                                             "ERROR"                                             "Im"                                                                                                                                            "RETURN" "Re"                                                                            "SearchText"                                                                                            "abs"       "addressof" "alias" "anames"                  "appendto" "array" "assemble" "assigned"                                            "callback" "cat" "coeff" "coeffs"             "convert"            "debugopts"                   "degree"         "diff" "disassemble" "divide"                    "entries" "eval" "evalb" "evalf" "`evalf/hypergeom`"                  "evalhf" "evaln" "expand"                              "frontend" "gc" "genpoly"                    "goto" "has" "hastype"           "icontent" "`if`" "igcd" "ilog10"                     "indets" "indices"         "intersect" "`int/series`"         "iquo" "irem"          "isqrt"                                   "lcoeff" "ldegree" "length" "lexorder"       "lprint" "macro" "map"        "max" "maxnorm" "member" "min" "`minus`"         "modp" "modp1"         "mods"                             "nops" "normal"         "numboccur" "numer" "op"        "order"                    "parse"             "pointto" "print" "printf" "protect"          "readlib" "readline"                                                                                                                                                                                                                                                                                                                          "searchtext" "select"                "seq" "series"                                   "sign" "sort" "sscanf" "ssystem"                       "subs"            "subsop" "substring" "system" "table" "taylor" "tcoeff" "time"             "traperror" "trunc" "type"             "unames"          "`union`" "unprotect" "userinfo" "words" "writeto"         ))
+;;    (4 .  ("`$`" "`*`"        "`+`"                                                                                                       "ASSERT"                                   "DEBUG"                                                 "ERROR"                                             "Im"           "MorrBrilCull"                                                                                                                   "RETURN" "Re"                                                                            "SearchText"                                                                                            "abs" "add" "addressof" "alias" "anames"                  "appendto" "array" "assemble" "assigned" "attributes"                               "callback" "cat" "coeff" "coeffs"             "convert"            "debugopts"                   "degree" "denom" "diff" "disassemble" "divide"                    "entries" "eval" "evalb" "evalf" "`evalf/hypergeom`"                  "evalhf" "evaln" "expand"                              "frontend" "gc" "genpoly" "getuserinterface" "goto" "has" "hastype"           "icontent" "`if`" "igcd" "ilog10"                     "indets" "indices" "inner" "intersect" "`int/series`" "iolib" "iquo" "irem"          "isqrt" "kernelopts" "`kernel/transpose`" "lcoeff" "ldegree" "length" "lexorder"       "lprint" "macro" "map" "map2" "max" "maxnorm" "member" "min" "`minus`"         "modp" "modp1"         "mods" "mul"                       "nops" "normal"         "numboccur" "numer" "op"        "order"                    "parse"             "pointto" "print"                             "readlib"                                                                                                                                                                                                                                                                                                                                     "searchtext" "select"                "seq" "series" "setattribute" "setuserinterface" "sign" "sort"          "ssystem"                       "subs"            "subsop" "substring" "system" "table" "taylor" "tcoeff" "time"             "traperror" "trunc" "type" "typematch" "unames"          "`union`"             "userinfo"         "writeto"         ))
+;;    (5 .  ("`$`" "`*`" "`**`" "`+`"               "`<`" "`<=`" "`<>`" "`=`" "`>`" "`>=`"                                            "`^`" "ASSERT"                                   "DEBUG"                                                 "ERROR"                                             "Im"           "MorrBrilCull"                                                                                                                   "RETURN" "Re"                                                                            "SearchText"                                                                                            "abs" "add" "addressof" "alias" "anames"                  "appendto" "array" "assemble" "assigned" "attributes"        "call"                 "callback" "cat" "coeff" "coeffs"             "convert" "crinterp" "debugopts" "define"          "degree" "denom" "diff" "disassemble" "divide"                    "entries" "eval" "evalb" "evalf" "`evalf/hypergeom/kernel`"           "evalhf" "evaln" "expand"                              "frontend" "gc" "genpoly" "getuserinterface" "goto" "has" "hastype" "hfarray" "icontent" "`if`" "igcd" "ilog10"                     "indets" "indices" "inner" "intersect" "`int/series`" "iolib" "iquo" "irem"          "isqrt" "kernelopts" "`kernel/transpose`" "lcoeff" "ldegree" "length" "lexorder"       "lprint" "macro" "map" "map2" "max" "maxnorm" "member" "min" "`minus`"         "modp" "modp1"         "mods" "mul"                       "nops" "normal"         "numboccur" "numer" "op"        "order"                    "parse"             "pointto" "print"                             "readlib"                                                                                                                                                                                                                                                                                                                                     "searchtext" "select"                "seq" "series" "setattribute" "setuserinterface" "sign" "sort"          "ssystem"                       "subs"            "subsop" "substring" "system" "table" "taylor" "tcoeff" "time" "timelimit" "traperror" "trunc" "type" "typematch" "unames"          "`union`"             "userinfo"         "writeto"         ))
+;;    (6 .  ("`$`" "`*`" "`**`" "`+`"               "`<`" "`<=`" "`<>`" "`=`" "`>`" "`>=`"                        "`||`"              "`^`" "ASSERT" "Array" "ArrayOptions" "CopySign" "DEBUG" "Default0" "DefaultOverflow" "DefaultUnderflow" "ERROR" "EqualEntries" "EqualStructure" "FromInert" "Im" "MPFloat" "MorrBrilCull" "NextAfter"              "NumericClass" "NumericEvent" "NumericEventHandler" "NumericStatus"          "OrderedNE" "RETURN" "Re"                       "SFloatExponent" "SFloatMantissa" "Scale10" "Scale2" "SearchText" "TRACE" "ToInert" "Unordered"                                                              "abs" "add" "addressof" "alias" "anames" "`and`"          "appendto" "array" "assemble" "assigned" "attributes" "bind"        "call_external" "callback" "cat" "coeff" "coeffs" "conjugate" "convert" "crinterp" "debugopts" "define_external" "degree" "denom" "diff" "disassemble" "divide"           "`done`" "entries" "eval" "evalb" "evalf" "`evalf/hypergeom/kernel`" "evalgf1" "evalhf" "evaln" "expand" "exports"             "frem" "frontend" "gc" "genpoly"                    "goto" "has" "hastype" "hfarray" "icontent" "`if`" "igcd" "ilog10" "ilog2"             "indets" "indices" "inner" "intersect" "`int/series`" "iolib" "iquo" "irem"          "isqrt" "kernelopts" "`kernel/transpose`" "lcoeff" "ldegree" "length" "lexorder" "lhs" "lprint" "macro" "map" "map2" "max" "maxnorm" "member" "min" "`minus`"         "modp" "modp1" "modp2" "mods" "mul" "mvMultiply" "negate" "nops" "normal" "`not`" "numboccur" "numer" "op" "`or`" "order"                    "parse"             "pointto" "print"                    "`quit`" "readlib"              "remove" "rhs" "rtable" "rtableInfo"                                                       "rtable_indfns" "rtable_is_zero" "rtable_normalize_index" "rtable_num_dims" "rtable_num_elems" "rtable_options"                               "rtable_scanblock"               "rtable_sort_indices"                        "searchtext" "select" "selectremove" "seq" "series" "setattribute"                    "sign" "sort"          "ssystem" "`stop`" "streamcall" "subs"            "subsop" "substring" "system" "table" "taylor" "tcoeff" "time" "timelimit" "traperror" "trunc" "type" "typematch" "unames" "unbind" "`union`"             "userinfo"         "writeto"         ))
+;;    (7 .  ("`$`" "`*`" "`**`" "`+`"               "`<`" "`<=`" "`<>`" "`=`" "`>`" "`>=`"                        "`||`"              "`^`" "ASSERT" "Array" "ArrayOptions" "CopySign" "DEBUG" "Default0" "DefaultOverflow" "DefaultUnderflow" "ERROR" "EqualEntries" "EqualStructure" "FromInert" "Im" "MPFloat" "MorrBrilCull" "NextAfter"              "NumericClass" "NumericEvent" "NumericEventHandler" "NumericStatus"          "OrderedNE" "RETURN" "Re"                       "SFloatExponent" "SFloatMantissa" "Scale10" "Scale2" "SearchText" "TRACE" "ToInert" "Unordered"                                 "_treeMatch" "_unify" "_xml" "abs" "add" "addressof" "alias" "anames" "`and`"          "appendto" "array" "assemble" "assigned" "attributes" "bind"        "call_external" "callback" "cat" "coeff" "coeffs" "conjugate" "convert" "crinterp" "debugopts" "define_external" "degree" "denom" "diff" "disassemble" "divide" "dlclose" "`done`" "entries" "eval" "evalb" "evalf" "`evalf/hypergeom/kernel`" "evalgf1" "evalhf" "evaln" "expand" "exports" "factorial" "frem" "frontend" "gc" "genpoly"                    "goto" "has" "hastype" "hfarray" "icontent" "`if`" "igcd" "ilog10" "ilog2" "'implies'" "indets" "indices" "inner" "intersect" "`int/series`" "iolib" "iquo" "irem"          "isqrt" "kernelopts" "`kernel/transpose`" "lcoeff" "ldegree" "length" "lexorder" "lhs" "lprint" "macro" "map" "map2" "max" "maxnorm" "member" "min" "`minus`"         "modp" "modp1" "modp2" "mods" "mul" "mvMultiply" "negate" "nops" "normal" "`not`" "numboccur" "numer" "op" "`or`" "order"                    "parse"             "pointto" "print"                    "`quit`" "readlib"              "remove" "rhs" "rtable" "rtableInfo"                                                       "rtable_indfns" "rtable_is_zero" "rtable_normalize_index" "rtable_num_dims" "rtable_num_elems" "rtable_options"                               "rtable_scanblock"               "rtable_sort_indices"                        "searchtext" "select" "selectremove" "seq" "series" "setattribute"                    "sign" "sort"          "ssystem" "`stop`" "streamcall" "subs" "`subset`" "subsop" "substring" "system" "table" "taylor" "tcoeff" "time" "timelimit" "traperror" "trunc" "type" "typematch" "unames" "unbind" "`union`"             "userinfo"         "writeto" "`xor`" ))
+;;    (8 .  ("`$`" "`*`" "`**`" "`+`"               "`<`" "`<=`" "`<>`" "`=`" "`>`" "`>=`"                        "`||`"              "`^`" "ASSERT" "Array" "ArrayOptions" "CopySign" "DEBUG" "Default0" "DefaultOverflow" "DefaultUnderflow" "ERROR" "EqualEntries" "EqualStructure" "FromInert" "Im" "MPFloat" "MorrBrilCull" "NextAfter"              "NumericClass" "NumericEvent" "NumericEventHandler" "NumericStatus"          "OrderedNE" "RETURN" "Re"                       "SFloatExponent" "SFloatMantissa" "Scale10" "Scale2" "SearchText" "TRACE" "ToInert" "Unordered"                "_jvm" "_maplet" "_treeMatch" "_unify" "_xml" "abs" "add" "addressof" "alias" "anames" "`and`" "andmap" "appendto" "array" "assemble" "assigned" "attributes" "bind"        "call_external" "callback" "cat" "coeff" "coeffs" "conjugate" "convert" "crinterp" "debugopts" "define_external" "degree" "denom" "diff" "disassemble" "divide" "dlclose" "`done`" "entries" "eval" "evalb" "evalf" "`evalf/hypergeom/kernel`" "evalgf1" "evalhf" "evaln" "expand" "exports" "factorial" "frem" "frontend" "gc" "genpoly"                    "goto" "has" "hastype" "hfarray" "icontent" "`if`" "igcd" "ilog10" "ilog2" "'implies'" "indets" "indices" "inner" "intersect" "`int/series`" "iolib" "iquo" "irem"          "isqrt" "kernelopts" "`kernel/transpose`" "lcoeff" "ldegree" "length" "lexorder" "lhs" "lprint" "macro" "map" "map2" "max" "maxnorm" "member" "min" "`minus`"         "modp" "modp1" "modp2" "mods" "mul" "mvMultiply" "negate" "nops" "normal" "`not`" "numboccur" "numer" "op" "`or`" "order" "ormap"            "parse"             "pointto" "print"                    "`quit`" "readlib"              "remove" "rhs" "rtable" "rtableInfo"                                                       "rtable_indfns" "rtable_is_zero" "rtable_normalize_index" "rtable_num_dims" "rtable_num_elems" "rtable_options"                               "rtable_scanblock"               "rtable_sort_indices"                        "searchtext" "select" "selectremove" "seq" "series" "setattribute"                    "sign" "sort"          "ssystem" "`stop`" "streamcall" "subs" "`subset`" "subsop" "substring" "system" "table" "taylor" "tcoeff" "time" "timelimit" "traperror" "trunc" "type" "typematch" "unames" "unbind" "`union`"             "userinfo"         "writeto" "`xor`" ))
+;;    (9 .  ("`$`" "`*`" "`**`" "`+`" "`..`"        "`<`" "`<=`" "`<>`" "`=`" "`>`" "`>=`"                        "`||`"              "`^`" "ASSERT" "Array" "ArrayOptions" "CopySign" "DEBUG" "Default0" "DefaultOverflow" "DefaultUnderflow" "ERROR" "EqualEntries" "EqualStructure" "FromInert" "Im" "MPFloat" "MorrBrilCull" "NextAfter" "Normalizer" "NumericClass" "NumericEvent" "NumericEventHandler" "NumericStatus"          "OrderedNE" "RETURN" "Re"                       "SFloatExponent" "SFloatMantissa" "Scale10" "Scale2" "SearchText" "TRACE" "ToInert" "Unordered" "UpdateSource" "_jvm" "_maplet" "_treeMatch" "_unify" "_xml" "abs" "add" "addressof" "alias" "anames" "`and`" "andmap" "appendto" "array" "assemble" "assigned" "attributes" "bind"        "call_external" "callback" "cat" "coeff" "coeffs" "conjugate" "convert" "crinterp" "debugopts" "define_external" "degree" "denom" "diff" "disassemble" "divide" "dlclose" "`done`" "entries" "eval" "evalb" "evalf" "`evalf/hypergeom/kernel`" "evalgf1" "evalhf" "evaln" "expand" "exports" "factorial" "frem" "frontend" "gc" "genpoly" "gmp_isprime"      "goto" "has" "hastype" "hfarray" "icontent" "`if`" "igcd" "ilog10" "ilog2" "'implies'" "indets" "indices" "inner" "intersect" "`int/series`" "iolib" "iquo" "irem" "is_gmp" "isqrt" "kernelopts" "`kernel/transpose`" "lcoeff" "ldegree" "length" "lexorder" "lhs" "lprint" "macro" "map" "map2" "max" "maxnorm" "member" "min" "`minus`" "`mod`" "modp" "modp1" "modp2" "mods" "mul" "mvMultiply" "negate" "nops" "normal" "`not`" "numboccur" "numer" "op" "`or`" "order" "ormap"            "parse" "piecewise" "pointto" "print"                    "`quit`" "readlib" "reduce_opr" "remove" "rhs" "rtable" "rtableInfo"                      "rtable_eval"                    "rtable_indfns" "rtable_is_zero" "rtable_normalize_index" "rtable_num_dims" "rtable_num_elems" "rtable_options"                               "rtable_scanblock"               "rtable_sort_indices" "rtable_zip"           "searchtext" "select" "selectremove" "seq" "series" "setattribute"                    "sign" "sort"          "ssystem" "`stop`" "streamcall" "subs" "`subset`" "subsop" "substring" "system" "table" "taylor" "tcoeff" "time" "timelimit" "traperror" "trunc" "type" "typematch" "unames" "unbind" "`union`"             "userinfo"         "writeto" "`xor`" ))
+;;    (10 . ("`$`" "`*`" "`**`" "`+`" "`..`"        "`<`" "`<=`" "`<>`" "`=`" "`>`" "`>=`" "`?()`" "`?[]`" "`{}`" "`||`"       "`[]`" "`^`" "ASSERT" "Array" "ArrayOptions" "CopySign" "DEBUG" "Default0" "DefaultOverflow" "DefaultUnderflow" "ERROR" "EqualEntries" "EqualStructure" "FromInert" "Im" "MPFloat" "MorrBrilCull" "NextAfter" "Normalizer" "NumericClass" "NumericEvent" "NumericEventHandler" "NumericStatus"          "OrderedNE" "RETURN" "Re"          "SDMPolynom" "SFloatExponent" "SFloatMantissa" "Scale10" "Scale2" "SearchText" "TRACE" "ToInert" "Unordered" "UpdateSource" "_jvm" "_maplet" "_treeMatch" "_unify" "_xml" "abs" "add" "addressof" "alias" "anames" "`and`" "andmap" "appendto" "array" "assemble" "assigned" "attributes" "bind"        "call_external" "callback" "cat" "coeff" "coeffs" "conjugate" "convert" "crinterp" "debugopts" "define_external" "degree" "denom" "diff" "disassemble" "divide" "dlclose" "`done`" "entries" "eval" "evalb" "evalf" "`evalf/hypergeom/kernel`" "evalgf1" "evalhf" "evaln" "expand" "exports" "factorial" "frem" "frontend" "gc" "genpoly" "gmp_isprime"      "goto" "has" "hastype" "hfarray" "icontent" "`if`" "igcd" "ilog10" "ilog2" "'implies'" "indets" "indices" "inner" "intersect" "`int/series`" "iolib" "iquo" "irem" "is_gmp" "isqrt" "kernelopts" "`kernel/transpose`" "lcoeff" "ldegree" "length" "lexorder" "lhs" "lprint" "macro" "map" "map2" "max" "maxnorm" "member" "min" "`minus`" "`mod`" "modp" "modp1" "modp2" "mods" "mul" "mvMultiply" "negate" "nops" "normal" "`not`" "numboccur" "numer" "op" "`or`" "order" "ormap" "overload" "parse" "piecewise" "pointto" "print"                    "`quit`" "readlib" "reduce_opr" "remove" "rhs" "rtable" "rtableInfo" "rtable_convolution" "rtable_eval" "rtable_histogram" "rtable_indfns" "rtable_is_zero" "rtable_normalize_index" "rtable_num_dims" "rtable_num_elems" "rtable_options" "rtable_redim" "rtable_scale" "rtable_scanblock"               "rtable_sort_indices" "rtable_zip" "savelib" "searchtext" "select" "selectremove" "seq" "series" "setattribute"                    "sign" "sort"          "ssystem" "`stop`" "streamcall" "subs" "`subset`" "subsop" "substring" "system" "table" "taylor" "tcoeff" "time" "timelimit" "traperror" "trunc" "type" "typematch" "unames" "unbind" "`union`"             "userinfo"         "writeto" "`xor`" ))
+;;    (11 . ("`$`" "`*`" "`**`" "`+`" "`..`"        "`<`" "`<=`" "`<>`" "`=`" "`>`" "`>=`" "`?()`" "`?[]`" "`{}`" "`||`"       "`[]`" "`^`" "ASSERT" "Array" "ArrayOptions" "CopySign" "DEBUG" "Default0" "DefaultOverflow" "DefaultUnderflow" "ERROR" "EqualEntries" "EqualStructure" "FromInert" "Im" "MPFloat" "MorrBrilCull" "NextAfter" "Normalizer" "NumericClass" "NumericEvent" "NumericEventHandler" "NumericStatus"          "OrderedNE" "RETURN" "Re"          "SDMPolynom" "SFloatExponent" "SFloatMantissa" "Scale10" "Scale2" "SearchText" "TRACE" "ToInert" "Unordered" "UpdateSource" "_jvm" "_maplet" "_treeMatch" "_unify" "_xml" "abs" "add" "addressof" "alias" "anames" "`and`" "andmap" "appendto" "array" "assemble" "assigned" "attributes" "bind"        "call_external" "callback" "cat" "coeff" "coeffs" "conjugate" "convert" "crinterp" "debugopts" "define_external" "degree" "denom" "diff" "disassemble" "divide" "dlclose" "`done`" "entries" "eval" "evalb" "evalf" "`evalf/hypergeom/kernel`" "evalgf1" "evalhf" "evaln" "expand" "exports" "factorial" "frem" "frontend" "gc" "genpoly" "gmp_isprime"      "goto" "has" "hastype" "hfarray" "icontent" "`if`" "igcd" "ilog10" "ilog2" "'implies'" "indets" "indices" "inner" "intersect" "`int/series`" "iolib" "iquo" "irem" "is_gmp" "isqrt" "kernelopts" "`kernel/transpose`" "lcoeff" "ldegree" "length" "lexorder" "lhs" "lprint" "macro" "map" "map2" "max" "maxnorm" "member" "min" "`minus`" "`mod`" "modp" "modp1" "modp2" "mods" "mul" "mvMultiply" "negate" "nops" "normal" "`not`" "numboccur" "numer" "op" "`or`" "order" "ormap" "overload" "parse" "piecewise" "pointto" "print"                    "`quit`" "readlib" "reduce_opr" "remove" "rhs" "rtable" "rtableInfo" "rtable_convolution" "rtable_eval" "rtable_histogram" "rtable_indfns" "rtable_is_zero" "rtable_normalize_index" "rtable_num_dims" "rtable_num_elems" "rtable_options" "rtable_redim" "rtable_scale" "rtable_scanblock"               "rtable_sort_indices" "rtable_zip" "savelib" "searchtext" "select" "selectremove" "seq" "series" "setattribute"                    "sign" "sort"          "ssystem" "`stop`" "streamcall" "subs" "`subset`" "subsop" "substring" "system" "table" "taylor" "tcoeff" "time" "timelimit" "traperror" "trunc" "type" "typematch" "unames" "unbind" "`union`"             "userinfo"         "writeto" "`xor`" ))
+;;    (12 . ("`$`" "`*`" "`**`" "`+`" "`..`"        "`<`" "`<=`" "`<>`" "`=`" "`>`" "`>=`" "`?()`" "`?[]`" "`{}`" "`||`"       "`[]`" "`^`" "ASSERT" "Array" "ArrayOptions" "CopySign" "DEBUG" "Default0" "DefaultOverflow" "DefaultUnderflow" "ERROR" "EqualEntries" "EqualStructure" "FromInert" "Im" "MPFloat" "MorrBrilCull" "NextAfter" "Normalizer" "NumericClass" "NumericEvent" "NumericEventHandler" "NumericStatus"          "OrderedNE" "RETURN" "Re" "Record" "SDMPolynom" "SFloatExponent" "SFloatMantissa" "Scale10" "Scale2" "SearchText" "TRACE" "ToInert" "Unordered" "UpdateSource" "_jvm" "_maplet" "_treeMatch" "_unify" "_xml" "abs" "add" "addressof" "alias" "anames" "`and`" "andmap" "appendto" "array" "assemble" "assigned" "attributes" "bind"        "call_external" "callback" "cat" "coeff" "coeffs" "conjugate" "convert" "crinterp" "debugopts" "define_external" "degree" "denom" "diff" "disassemble" "divide" "dlclose" "`done`" "entries" "eval" "evalb" "evalf" "`evalf/hypergeom/kernel`" "evalgf1" "evalhf" "evaln" "expand" "exports" "factorial" "frem" "frontend" "gc" "genpoly" "gmp_isprime"      "goto" "has" "hastype" "hfarray" "icontent" "`if`" "igcd" "ilog10" "ilog2" "'implies'" "indets" "indices" "inner" "intersect" "`int/series`" "iolib" "iquo" "irem" "is_gmp" "isqrt" "kernelopts" "`kernel/transpose`" "lcoeff" "ldegree" "length" "lexorder" "lhs" "lprint" "macro" "map" "map2" "max" "maxnorm" "member" "min" "`minus`" "`mod`" "modp" "modp1" "modp2" "mods" "mul" "mvMultiply" "negate" "nops" "normal" "`not`" "numboccur" "numer" "op" "`or`" "order" "ormap" "overload" "parse" "piecewise" "pointto" "print"                    "`quit`" "readlib" "reduce_opr" "remove" "rhs" "rtable" "rtableInfo" "rtable_convolution" "rtable_eval" "rtable_histogram" "rtable_indfns" "rtable_is_zero" "rtable_normalize_index" "rtable_num_dims" "rtable_num_elems" "rtable_options" "rtable_redim" "rtable_scale" "rtable_scanblock" "rtable_size" "rtable_sort_indices" "rtable_zip" "savelib" "searchtext" "select" "selectremove" "seq" "series" "setattribute"                    "sign" "sort"          "ssystem" "`stop`" "streamcall" "subs" "`subset`" "subsop" "substring" "system" "table" "taylor" "tcoeff" "time" "timelimit" "traperror" "trunc" "type" "typematch" "unames" "unbind" "`union`"             "userinfo"         "writeto" "`xor`" ))
+;;    (13 . ("`$`" "`*`" "`**`" "`+`" "`..`" "`::`" "`<`" "`<=`" "`<>`" "`=`" "`>`" "`>=`" "`?()`" "`?[]`" "`{}`" "`||`" "`~`" "`[]`" "`^`" "ASSERT" "Array" "ArrayOptions" "CopySign" "DEBUG" "Default0" "DefaultOverflow" "DefaultUnderflow" "ERROR" "EqualEntries" "EqualStructure" "FromInert" "Im" "MPFloat" "MorrBrilCull" "NextAfter" "Normalizer" "NumericClass" "NumericEvent" "NumericEventHandler" "NumericStatus"          "OrderedNE" "RETURN" "Re" "Record" "SDMPolynom" "SFloatExponent" "SFloatMantissa" "Scale10" "Scale2" "SearchText" "TRACE" "ToInert" "Unordered" "UpdateSource" "_jvm" "_maplet" "_treeMatch" "_unify" "_xml" "abs" "add" "addressof" "alias" "anames" "`and`" "andmap" "appendto" "array" "assemble" "assigned" "attributes" "bind"        "call_external" "callback" "cat" "coeff" "coeffs" "conjugate" "convert" "crinterp" "debugopts" "define_external" "degree" "denom" "diff" "disassemble" "divide" "dlclose" "`done`" "entries" "eval" "evalb" "evalf" "`evalf/hypergeom/kernel`" "evalgf1" "evalhf" "evaln" "expand" "exports" "factorial" "frem" "frontend" "gc" "genpoly" "gmp_isprime"      "goto" "has" "hastype" "hfarray" "icontent" "`if`" "igcd" "ilog10" "ilog2" "`implies`" "indets" "indices" "inner" "intersect" "`int/series`" "iolib" "iquo" "irem" "is_gmp" "isqrt" "kernelopts" "`kernel/transpose`" "lcoeff" "ldegree" "length" "lexorder" "lhs" "lprint" "macro" "map" "map2" "max" "maxnorm" "member" "min" "`minus`" "`mod`" "modp" "modp1" "modp2" "mods" "mul" "mvMultiply" "negate" "nops" "normal" "`not`" "numboccur" "numer" "op" "`or`" "order" "ormap" "overload" "parse" "piecewise" "pointto" "print"                    "`quit`" "readlib" "reduce_opr" "remove" "rhs" "rtable" "rtableInfo" "rtable_convolution" "rtable_eval" "rtable_histogram" "rtable_indfns" "rtable_is_zero" "rtable_normalize_index" "rtable_num_dims" "rtable_num_elems" "rtable_options" "rtable_redim" "rtable_scale" "rtable_scanblock" "rtable_size" "rtable_sort_indices" "rtable_zip" "savelib" "searchtext" "select" "selectremove" "seq" "series" "setattribute"                    "sign" "sort"          "ssystem" "`stop`" "streamcall" "subs" "`subset`" "subsop" "substring" "system" "table" "taylor" "tcoeff" "time" "timelimit" "traperror" "trunc" "type" "typematch" "unames" "unbind" "`union`"             "userinfo"         "writeto" "`xor`" )) 
+;;    (14 . ("`$`" "`*`" "`**`" "`+`" "`..`" "`::`" "`<`" "`<=`" "`<>`" "`=`" "`>`" "`>=`" "`?()`" "`?[]`" "`{}`" "`||`" "`~`" "`[]`" "`^`" "ASSERT" "Array" "ArrayOptions" "CopySign" "DEBUG" "Default0" "DefaultOverflow" "DefaultUnderflow" "ERROR" "EqualEntries" "EqualStructure" "FromInert" "Im" "MPFloat" "MorrBrilCull" "NextAfter" "Normalizer" "NumericClass" "NumericEvent" "NumericEventHandler" "NumericStatus" "Object" "OrderedNE" "RETURN" "Re" "Record" "SDMPolynom" "SFloatExponent" "SFloatMantissa" "Scale10" "Scale2" "SearchText" "TRACE" "ToInert" "Unordered" "UpdateSource" "_jvm" "_maplet" "_treeMatch" "_unify" "_xml" "abs" "add" "addressof" "alias" "anames" "`and`" "andmap" "appendto" "array" "assemble" "assigned" "attributes" "bind"        "call_external" "callback" "cat" "coeff" "coeffs" "conjugate" "convert" "crinterp" "debugopts" "define_external" "degree" "denom" "diff" "disassemble" "divide" "dlclose" "`done`" "entries" "eval" "evalb" "evalf" "`evalf/hypergeom/kernel`" "evalgf1" "evalhf" "evaln" "expand" "exports" "factorial" "frem" "frontend" "gc" "genpoly" "gmp_isprime"      "goto" "has" "hastype" "hfarray" "icontent" "`if`" "igcd" "ilog10" "ilog2" "`implies`" "indets" "indices" "inner" "intersect" "`int/series`" "iolib" "iquo" "irem" "is_gmp" "isqrt" "kernelopts" "`kernel/transpose`" "lcoeff" "ldegree" "length" "lexorder" "lhs" "lprint" "macro" "map" "map2" "max" "maxnorm" "member" "min" "`minus`" "`mod`" "modp" "modp1" "modp2" "mods" "mul" "mvMultiply" "negate" "nops" "normal" "`not`" "numboccur" "numer" "op" "`or`" "order" "ormap" "overload" "parse" "piecewise" "pointto" "print"                    "`quit`" "readlib" "reduce_opr" "remove" "rhs" "rtable" "rtableInfo" "rtable_convolution" "rtable_eval" "rtable_histogram" "rtable_indfns" "rtable_is_zero" "rtable_normalize_index" "rtable_num_dims" "rtable_num_elems" "rtable_options" "rtable_redim" "rtable_scale" "rtable_scanblock" "rtable_size" "rtable_sort_indices" "rtable_zip" "savelib" "searchtext" "select" "selectremove" "seq" "series" "setattribute"                    "sign" "sort"          "ssystem" "`stop`" "streamcall" "subs" "`subset`" "subsop" "substring" "system" "table" "taylor" "tcoeff" "time" "timelimit" "traperror" "trunc" "type" "typematch" "unames" "unbind" "`union`"             "userinfo"         "writeto" "`xor`" )) 
+;;  "Alist of Maple builtin funtions. The key is the major release."))
+
+;;}}}
+
+(defun maplev--ditto-operators-re ()
+  "Return a regexp that matches the ditto operators."
+  (regexp-opt
+   (if (< (maplev--major-release) 5)
+       '("\"" "\"\"" "\"\"\"")
+     '("%" "%%" "%%%"))))
+
+(defvar maplev-protected-face   'maplev-protected-face
+  "*Face name for Maple protected names.")
+
+(defface maplev-protected-face
+  '((((class grayscale) (background light)) (:foreground "LightGray" :bold t))
+    (((class grayscale) (background dark))  (:foreground "DimGray"   :bold t))
+    (((class color)     (background light)) (:foreground "LImeGreen"))
+    (((class color)     (background dark))  (:foreground "LimeGreen"))
+    (t (:bold t)))
+  "Font lock mode face used for Maple protected names."
+  :group 'maplev-faces)
+
+(defconst maplev--protected-names-re
+  (eval-when-compile
+    (concat "\\<\\(?:"
+            (regexp-opt
+             (list "ARRAY" "Add" "And" "Cache" "Catalan" "Complex" "D" "DESol" "Ei" "Eval" "Expand" 
+                   "FAIL" "Float" "Fraction" "HFloat" "Implies" "ImportData" "Int" "Integer" 
+                   "JacobiAM" "JacobiCN" "JacobiCS" "JacobiNC" "JacobiNS" "JacobiSC" "JacobiSN"
+                   "LinearAlgebra" "ListTools" "Matlab" "Matrix"  "Multiply"
+                   "Non" "Normal" "Not" "NumericTools" "O" "Or" "Pi" "Plot" "Power" "Product" "RealRange"
+                   "SFloat" "Shift" "Sum" "SymbolicInfinity" "TABLE" "TEXT"
+                   "Vector" "VectorOptions" "WARNING" "Xor"
+                   "algebraic" "algext" "algfun" "algnum" "algnumext" 
+                   "ansi" "anyfunc" "anything" "apply" "atomic"
+                   "boolean" "bytesused"
+                   "charfcn" "collect" "combine" "complex" "complexcons" "constant" "copy" "cubic" "curry" "cx_infinity" "cx_zero"
+                   "dagtag" "deduced" "division_by_zero" 
+                   "echo" "embedded_axis" "embedded_imaginary" "embedded_real" "equation" "errorbreak" "errorcursor" 
+                   "evala" "evalr" "even" "evenfunc" "expanded" "extended_numeric" "extended_rational"
+                   "facint" "false" "fflush" "finite" "float" "fprintf" "frac" "fraction" "freeze" "function"
+                   "gamma" "gcfreq" "hasassumptions" "hasfun" "hfloat"
+                   "identical" "imaginary" "`in`" "indentamount" "interface" "index" "indexable" "indexed" "inexact" 
+                   "infinity" "integer" "invalid_operation" "invfunc" "iperfpow" "iroot" "is"
+                   "labelling" "laurent" "leadterm" "linear" "list" "listlist" "literal"
+                   "mathfunc" "matrix" "`module`" "moduledefinition" "monomial"
+                   "name" "negative" "neg_infinity" "negint" "negzero" "nonnegative" 
+                   "nonnegint" "nonposint" "nonpositive" "nonreal" "norm" "nothing" "numeric"
+                   "odd" "oddfunc" "overflow"
+                   "package" "plotdevice" "plotoptions" "plotoutput" "point" "polynom" "pos_infinity" "posint" "positive" 
+                   "postplot" "poszero" "preplot" "prettyprint" "prime" "primpart" "printbytes" "procedure" "prompt" "proot" "protected" "psqrt"
+                   "quadratic" "quartic" "quiet"
+                   "radext" "radfun" "radfunext" "radical" "radnormal" "radnum" "radnumext" "range" "rational" 
+                   "ratpoly" "rcurry" "real" "realcons" "real_infinity" "real_to_complex" "relation" "restart" "resultant" "round"
+                   "scalar" "screenheight" "screenwidth" "sequential" "set" "sfloat" "shake"
+                   "showassumed" "simplify" "specfunc" "sqrt" "stack" "string" "subtype" "symbol" "symmfunc"
+                   "tabular" "testeq" "thaw" "tracelast" "trig" "true" "truefalse"
+                   "unapply" "undefined" "underflow" "uneval" "usage"
+                   "vector" "verboseproc" "verify" "warnlevel" "with" "wordsize" "zppoly"
+		   
+		   "exp" "ln" "log" "log10"
+		   "sin" "cos" "tan"
+		   "sec" "csc" "cot"
+		   "sinh" "cosh" "tanh"
+		   "sech" "csch" "coth"
+
+		   "arcsin" "arccos" "arctan"
+		   "arcsec" "arccsc" "arccot"
+		   "arcsinh" "arccosh" "arctanh"
+		   "arcsech" "arccsch" "arccoth"
+                   ))
+            "\\)\\>")))
+
+
+(defconst maplev--protected-names-procs-re
+  (list "evalindets" "subsindets"))
+
+(defun maplev-font-lock-keywords-1 ()
+  "Compute the minimum decoration `font-lock-keywords' for MapleV mode.
+Top level procedures, Maple reserved words, and preprocessor directives
+are font locked."
+  (list
+   (list maplev--top-defun-begin-re '(1 font-lock-function-name-face t))
+   (list maplev--preprocessor-directives-re '(0 maplev-preprocessor-face))
+   (list (maplev--list-to-word-re
+          (cdr (assoc (maplev--major-release)
+                      maplev--reserved-words-alist)))
+         '(0 font-lock-keyword-face))))
+
+
+(defun maplev-font-lock-keywords-2 ()
+  "Compute the medium decoration `font-lock-keywords' for MapleV mode.
+Add special words, initial variables, and the ditto operators to the
+minimum decoration keywords."
+  (append
+   (maplev-font-lock-keywords-1)
+   (list
+    (list maplev--special-words-re     '(0 font-lock-variable-name-face))
+    (list maplev--initial-variables-re '(0 font-lock-reference-face))
+    (list (maplev--ditto-operators-re) '(0 font-lock-variable-name-face)))))
+
+(defun maplev-font-lock-keywords-3 ()
+  "Compute the maximum decoration `font-lock-keywords' for MapleV mode.
+Add builtin functions to the medium decoration keywords."
+  (let ((max-specpdl-size 10000))       ; default 600 is too small
+    (append (maplev-font-lock-keywords-2)
+            (list (list (maplev--list-to-word-re
+                         (cdr (assoc (maplev--major-release)
+                                     maplev--builtin-functions-alist)))
+                        ;; Xemacs doesn't have font-lock-builtin-face
+                        '(0 font-lock-variable-name-face))
+                  (list maplev--deprecated-re '(0 font-lock-warning-face))
+                  (list maplev--protected-names-re '(0 maplev-protected-face))))))
+
+(defun maplev--font-lock-keywords ()
+  "Return a list of symbols for font locking MapleV mode buffers."
+  '(maplev-font-lock-keywords-3        ; default is maximum decoration
+    maplev-font-lock-keywords-1
+    maplev-font-lock-keywords-2
+    maplev-font-lock-keywords-3))
+
+(defun maplev--font-lock-syntax-alist ()
+  "Return the syntax alist appropriate for font lock.
+It depends on `maplev--major-release'."
+  `((?_ . "w")                          ; make `_' a word character
+    ,(if (< (maplev--major-release) 5)
+         '(?\" . "w")     ; make `"' a word character for R4 and down.
+       '(?% . "w"))))       ; make `%' a word character for R5 and up.
+
+(defun maplev--syntax-begin ()
+  "Move backwards to start of a Maple procedure.
+This is passed to `font-lock-defaults' as the SYNTAX-BEGIN argument."
+  (re-search-backward maplev--top-defun-begin-re nil 'move))
+
+(defun maplev-reset-font-lock (&optional decoration)
+  "Reset the font lock patterns for MapleV mode.  Fontify the buffer.
+The optional argument DECORATION selects the level of font lock.
+If nil then `font-lock-maximum-decoration' selects the level."
+  (interactive (list (completing-read "Decoration (1-3): "
+                                      '(("1") ("2") ("3"))
+                                      nil t)))
+  (if decoration
+      (setq font-lock-maximum-decoration decoration))
+  (setq font-lock-defaults `(,(maplev--font-lock-keywords)
+                             nil nil
+                             ,(maplev--font-lock-syntax-alist)
+                             maplev--syntax-begin))
+  (font-lock-set-defaults)
+  (font-lock-fontify-buffer))
+
+;;}}}
+;;{{{ Tags
+
+;; I'm not sure about how tags should work.  Should it run on all
+;; Maple files in the directory?  Running it on just one file makes
+;; little sense.  The tags could be appended, but then the TAGS file
+;; will have lots of redunancy following multiple executions.
+
+;; (defcustom maplev-etags "etags"
+;;   "Etag program."
+;;   :type 'string
+;;   :group 'maplev)
+
+;; (defcustom maplev-tag-regexp
+;;   (concat "'/\\([^# \t]+\\)[ \t]*:=[ \t]*proc(/\\1/'")
+;;   "Regular expression used by etag."
+;;   :type 'string
+;;   :group 'maplev)
+
+;; ;; where does the following store the tag table?
+;; ;; Always in the same directory as the
+
+;; (defun maplev-tag-file ()
+;;   "Create a tags table for the existing buffer/file."
+;;   (interactive)
+;;   (shell-command
+;;    (concat maplev-etags
+;;         " --language=none --regex="
+;;         maplev-tag-regexp
+;;         " "
+;;         (buffer-file-name))))
+
+;;}}}
+
+;;{{{ Includes
+
+(defface maplev-find-include-file
+  '((((class grayscale) (background light)) (:foreground "LightGray" :underline t))
+    (((class grayscale) (background dark))  (:foreground "DarkGray" :underline t))
+    (((class color)     (background light)) (:foreground "DarkBlue" :underline t))
+    (((class color)     (background dark))  (:foreground "LightBlue" :underline t))
+    (t (:underline t)))
+  "Font lock face used for include filenames, indicates hyperlink."
+  :group 'maplev-faces)
+
+(defun maplev-buttonize-includes ()
+  "Buttonize the include statements."
+  (button-lock-mode t)
+  (button-lock-set-button maplev--include-directive-re
+			  'maplev-find-include-file-at-point
+			  :face 'link
+			  :face-policy 'prepend
+			  :grouping 2
+			  :keyboard-binding "C-c C-o"
+			  :help-text "open file"))
+
+(defun maplev-find-include-file-at-point (toggle)
+  "Open the include file at point.  If found, the file is opened
+either in this window or the other window, depending on the
+exclusive-or of TOGGLE with `maplev-include-file-other-window-flag'.  
+The variable `maplev-include-path' specifies the search paths; 
+it is a list of rooted strings.  If the file cannot be found, but 
+the proper directory exists, query user to create the file."
+  (interactive "P")
+  (save-excursion
+    (beginning-of-line)
+    (unless (looking-at maplev--include-directive-re)
+      (error "Not at an include statement"))
+    (let* ((inc-file (match-string-no-properties 2))
+	   (path maplev-include-path)
+	   (inc-first (string= "<" (match-string-no-properties 1)))
+	   file)
+      (setq file (maplev-find-include-file inc-file inc-first path))
+      (if file
+	  (find-file-other-window file)
+	;; file does not exist.  If suitable location can be found from include path,
+	;; query to create
+	(let ((base (file-name-nondirectory inc-file))
+	      (inc-dir inc-file))
+	  (while (and (setq inc-dir (file-name-directory (directory-file-name inc-dir)))
+		      (not (setq file (maplev-find-include-file inc-dir inc-first path)))))
+	(if (not file)
+	    (error "Include file %s does not exist " inc-file)
+	  (if (yes-or-no-p (format "Create include file %s "
+				   (setq file (concat file base))))
+	      (if (if maplev-include-file-other-window-flag
+		      (not toggle)
+		    toggle)
+		  (find-file-other-window file)
+		(find-file file)))))))))
+	  
+(defun maplev-find-include-file (inc-file &optional inc-first inc-path)
+  "Find the Maple include file INC-FILE and return as an absolute path.
+INC-PATH is an optional list of rooted directories.  Use each
+directory, in order, as parent of INC-FILE.  If INC-FIRST is
+non-nil, search the INC-PATH directories before using the
+`default-directory'.  If those searches fail, search each parent
+of `default-directory'.  Return nil if the file is not found."
+  (if (file-name-absolute-p inc-file)
+      (and (file-exists-p inc-file) inc-file)
+    (if inc-first
+	(or
+	 (maplev-include--find-file-in-path inc-file inc-path)
+	 (maplev-include--find-file-up-path inc-file))
+      (or (maplev-include--find-file-in-path inc-file (list default-directory))
+	  (maplev-include--find-file-in-path inc-file inc-path)
+	  (maplev-include--find-file-up-path inc-file)))))
+
+(defun maplev-include--find-file-in-path (file &optional paths)
+  "Search for FILE in a list of rooted PATHS, which include trailing slash.
+If found, return the absolute path to FILE, otherwise return nil."
+  (let (dir abs-file)
+    (while (not (progn
+		  (setq dir (car paths)
+			paths (cdr paths)
+			abs-file (concat dir file))
+		  (or (file-exists-p abs-file)
+		      (setq abs-file nil)
+		      (null paths)))))
+    (and abs-file
+	 (expand-file-name abs-file))))
+
+(defun maplev-include--find-file-up-path (file &optional dir)
+  "Find FILE, optionally searching in directory DIR.
+Look in each ancestor in DIR.  If DIR is nil, use `default-directory'.
+Return the absolute path to the file, if found, otherwise return
+nil."
+  (setq dir (file-name-as-directory (or dir default-directory)))
+  (let (parent abs-file)
+    (while
+	(if (file-exists-p (setq abs-file (concat dir file)))
+	    nil ; success; exit loop
+	  (if (or (null (setq parent (file-name-directory (directory-file-name dir))))
+		  (string= dir parent))
+	      (setq abs-file nil) ; at root, exit loop with empty file
+	    (setq dir parent)))) ; check parent
+    abs-file))
+		  
+(define-button-type 'maplev-find-include-file
+  'help-echo "Find include file"
+  'action 'maplev-find-include-file-at-point
+  'follow-link t
+  'face 'maplev-include-file)
+
+;;}}}
+
+;;{{{ Config file (.maplev)
+
+(defun maplev-load-config-file (&optional force)
+  "Find and load the maplev configuration file.
+The file is named .maplev and is searched for in the current
+directory and its ancestors.  Return t if configuration file was
+loaded, nil otherwise."
+  (let ((config (maplev-include--find-file-up-path ".maplev")))
+    (when config
+      (condition-case err
+	  (load-file config)
+	(error
+	 (message "An error occurred loading config file %s" config))))))
+
+;;}}}
+
+;;{{{ leading-comma stuff
+
+(defadvice fixup-whitespace (after maplev-fixup-whitespace)
+  "Catenate adjacent Maple strings (separated by one space) or,
+if `maplev-leading-comma-flag' is non-nil, remove space before a comma."
+  (if (and maplev-leading-comma-flag
+	   (looking-at " ,"))
+      (delete-char 1)
+    (when (and (looking-at " \"")
+	       (looking-back "\""))
+      (delete-char -1)
+      (delete-char 2))))
+	
+
+;;}}}
+
+;;; Process Modes
+
+;;{{{ Group definitions
+
+(defgroup maplev-buffer nil
+  "Maple buffer stuff \(mostly names\)."
+  :group 'maplev)
+
+(defgroup maplev-help nil
+  "Maple help pages."
+  :group 'maplev)
+
+(defgroup maplev-mint nil
+  "Mint setup."
+  :group 'maplev
+  :group 'maplev-executables)
+
+;;}}}
+;;{{{ Customizable variables
+
+;;{{{   buffers
+
+(defcustom maplev-pop-up-frames-flag nil
+  "Non-nil means help pages and procedure listings start in a separate frame."
+  :type 'boolean
+  :group 'maplev-misc)
+
+(defcustom maplev-cmaple-end-notice "END_OF_OUTPUT"
+  "Message used to indicate the end of Maple output."
+  :type 'string
+  :group 'maplev-misc)
+
+(defcustom maplev-cmaple-echoes-flag
+  (not (string-match "windows-nt\\|ms-dos" (symbol-name system-type)))
+  "Non-nil means the process echoes."
+  :type 'boolean
+  :group 'maplev-buffer
+  :group 'maplev-important)
+
+;;}}}
+;;{{{   maple setup
+(defcustom maplev-start-options (list "-q")
+  "List of Maple command line options.  Each item is a string."
+  :type 'list
+  :group 'maplev-executables)
+
+(defcustom maplev-startup-directory nil
+  "If non-nil, change to this directory before running Maple.
+Otherwise use the default directory of `maplev-cmaple-buffer'."
+  :type '(choice string (const :tag "default" nil))
+  :group 'maplev-executables)
+
+(defcustom maplev-cmaple-prompt "> "
+  "String inserted as prompt in Maple buffer."
+  :type 'string
+  :group 'maplev-executables
+  :group 'maplev-buffer)
+;;}}}
+
+;;}}}
+;;{{{ Internal variables
+
+(defvar maplev--history-stack nil
+  "Stack variable used for the history mechanism.
+It is local to the `maplev-help-mode' and `maplev-proc-mode' buffers.")
+
+(defvar maplev--process-item nil
+  "The name of a function that processes items on `maplev--history-stack'.
+It is local to the `maplev-help-mode' and `maplev-proc-mode' buffers.")
+
+;;}}}
+;;{{{ Release
+
+(defun maplev--help-buffer ()
+  "Return the name of the Maple help buffer."
+  (format "Maple %s help" maplev-release))
+
+(defun maplev--proc-buffer ()
+  "Return the name of the Maple procedure listing buffer."
+  (format "Maple %s proc" maplev-release))
+
+(defun maplev--cmaple-buffer ()
+  "Return the name of the Maple cmaple buffer."
+  (format "Maple %s" maplev-release))
+
+
+;;}}}
+;;{{{ Maple
+
+;;{{{   comm functions
+
+;; Define the functions used for communicating with the command line
+;; Maple process.
+;;
+;; A useful feature is having independent Maple processes associated
+;; with particular (source) buffers.  Doing so will require rewriting
+;; the access control, however, it should result in a more robust
+;; design.  Is it worth it? 
+;;
+;; One method to accomplish this is the following:
+;;
+;;  - Create a (source) buffer-local variable that stores the process.
+;;  - Create an (output) buffer-local flag variable that stores the lock status.
+;;
+;; To check whether the process is locked, make the output buffer the
+;; current buffer and check its flag variable.  When a second source
+;; buffer (first) requires a Maple process, the user should be queried
+;; (dependent on a configuration variation)  whether it should use an
+;; existing Maple process, provided it is of the proper release.
+;; Independent Maple output buffers should be numbered sequentially.
+;;
+;; A difficulty, or at least a nusiance, is handling the help and proc
+;; modes.  Ideally all source buffers that have the same Maple release
+;; would use a common help or proc buffer.  However, because proc may
+;; depend on the state of Maple, its buffer must be associated with a
+;; specific Maple process.  The straightforward solution is to have a
+;; separate help or proc buffer associated with each independent Maple
+;; process.  It leads to more buffers than I'd like.  
+
+(defun maplev--cmaple-process ()
+  "Return the cmaple process associated with the current buffer.
+Start one, if necessary."
+  (let ((process (get-buffer-process (maplev--cmaple-buffer))))
+    (if (and process (eq (process-status process) 'run))
+        process
+      (maplev-cmaple--start-process))))
+
+(defun maplev--cmaple-get-init-string (release)
+  "Return the initialization string passed to the Maple process.
+If RELEASE is an index in `maplev-init-string-alist' then use the entry,
+otherwise use `maplev-default-init-string'."
+  (let ((init (assoc release maplev-init-string-alist)))
+    (if init
+        (cdr init)
+      maplev-default-init-string)))
+
+(defun maplev-cmaple--start-process ()
+  "Start a cmaple process associated with the current buffer.
+Return the process.  If such a process already exists, kill it and
+restart it."
+  (let* ((release maplev-release)
+         (cmaple (nth 0 (cdr (assoc release maplev-executable-alist))))
+         (inifile (nth 1 (cdr (assoc release maplev-executable-alist))))
+         (buffer (get-buffer-create (maplev--cmaple-buffer)))
+         (process (get-buffer-process buffer))
+	 (include-path maplev-include-path)
+         ;; Just testing this.  Is there an advantage to a PTY process?
+         (process-connection-type 'pty)) 
+    (with-current-buffer buffer
+      (message "Starting Maple %s..." release)
+      (if process (delete-process process))
+      (if maplev-startup-directory
+          (cd (expand-file-name maplev-startup-directory)))
+      (set-process-filter
+       ;; `apply' is used because `maplev-start-options' is a list.
+       (setq process (apply 'start-process
+                            (format "Maple %s" release)
+                            buffer
+                            cmaple
+                            (append (and inifile (list "-i" inifile))
+                                    maplev-start-options ;; add include path to argument list
+                                    (and include-path
+                                         (list (concat "-I " 
+                                                       (mapconcat 'identity include-path ",")))))))
+       'maplev--cmaple-filter)
+      (maplev-cmaple-mode release)
+      (maplev-cmaple--lock-access t)
+      (comint-simple-send process (maplev--cmaple-get-init-string release))
+      (maplev-cmaple--send-end-notice process)
+      ;; Wait until cmaple is unlocked, that is, it has responded.
+      ;; The time step, 100 milliseconds, should be customizable, some OSs
+      ;; do not support fractions of seconds.
+      ;; (while (maplev-cmaple--locked-p) (maplev--short-delay))
+      (maplev-cmaple--wait)
+      (message "Maple %s started" release)
+      process)))
+
+;; Access control
+
+;; JR: Are the lines marked "hieida" the original or his suggested
+;; correction?  I don't see the point of using a fixed symbol,
+;; maplev-release as the property in which to store the lock status.
+;; Using the value of maplev-release makes sense.  Alas, I no longer
+;; have his email.  A better way to handle this might be to attach the
+;; property to a buffer local variable.  However, I don't think that
+;; that is possible.  Possibly the correct technique is to create a
+;; flag variable that is local to the Maple output buffer and assign
+;; to it.
+
+(defun maplev-cmaple--lock-access (&optional no-error)
+  "Lock access to cmaple.
+If access is already locked, generate an error
+unless optional arg NO-ERROR is non-nil."
+  (if (and (not no-error) (maplev-cmaple--locked-p))
+      (error "Maple busy")
+;;hieida:
+;;    (put 'maplev-cmaple-state maplev-release 'locked)))
+    (put 'maplev-cmaple-state 'maplev-release 'locked)))
+
+(defun maplev-cmaple--unlock-access ()
+  "Unlock access to cmaple.
+Interactively use \\[maplev-cmaple-interrupt]."
+;;hieida:
+;;  (put 'maplev-cmaple-state maplev-release nil))
+  (put 'maplev-cmaple-state 'maplev-release nil))
+
+(defun maplev-cmaple--locked-p ()
+  "Return non-nil if the Maple process is locked."
+;;hieida:
+;;  (eq (get 'maplev-cmaple-state maplev-release) 'locked))
+  (eq (get 'maplev-cmaple-state 'maplev-release) 'locked))
+
+(defun maplev-cmaple-status ()
+  "Status of Maple process."
+  (interactive)
+;;hieida:
+;;  (let ((status (get 'maplev-cmaple-state maplev-release)))
+  (let ((status (get 'maplev-cmaple-state 'maplev-release)))
+    (message "Maple %s %s" maplev-release
+             (cond ((eq status 'locked) "locked")
+                   ((not status) "unlocked")
+                   (status)))))
+
+(defun maplev-cmaple--wait (&optional max-cnt no-err)
+  "Wait for cmaple to become available.  
+If optional argument MAX-CNT is non-nil, wait at most that many
+seconds; otherwise wait indefinitly.  If optional argument NO-ERR is
+non-nil do not generate an error if time-out occurs."
+  (with-temp-message "Maple busy, waiting..."
+    (let ((cnt (* 10 (or max-cnt 0))))
+      (while (and (maplev-cmaple--locked-p)
+                  (or (null max-cnt)
+                      (< 0 (setq cnt (1- cnt)))))
+        ;; Should sit-for be used instead?  It permits interrupting
+        ;; via user input (keystrokes).
+        (sleep-for 0.1))
+      (and (not no-err)
+           (maplev-cmaple--locked-p)
+           (error "Maple busy")))))
+
+;; Functions that send stuff to cmaple
+
+(defun maplev-cmaple-send ()
+  "Send input to Maple."
+  (interactive)
+  (let ((pmark (process-mark (maplev--cmaple-process)))
+        (maplev-mint-info-level maplev-mint-error-level)
+        (comint-input-sender (function maplev-cmaple--send-string)))
+    ;; Only _new_ input is checked for typos, see comint-send-input.
+    ;; We might need something smarter for comint-get-old-input.
+    ;; Why does comint-send-input use (line-end-position) instead of
+    ;; (point-max)?  To be consistent maplev-mint-region does the same.
+    (if (or (< (point) (marker-position pmark))
+            (equal 0 (maplev-mint-region pmark (line-end-position))))
+        (comint-send-input))))
+
+(defun maplev-cmaple--send-string (process string)
+  "Send STRING to the cmaple process PROCESS."
+  ;; handle Maple `restart' by adding the initialization.
+  (let ((str "") case-fold-search)
+    (while (string-match "\\ (length string) (match-end 0))
+                       (substring string (match-end 0))
+                     "")))
+    (setq string (concat str string)))
+  (maplev-cmaple--lock-access)
+  (set-process-filter process 'maplev--cmaple-filter)
+  (comint-simple-send process string)
+  (maplev-cmaple--send-end-notice process))
+
+(defun maplev-cmaple-send-region (beg end)
+  "Send the region from BEG to END to cmaple.
+If called interactively use the marked region.
+If called with a prefix the cmaple buffer is first cleared."
+  (interactive "r")
+  (let ((maplev-mint-info-level maplev-mint-error-level)) ;; TODO: Change to -S for syntax only!
+    (when (equal 0 (maplev-mint-region beg end))
+      (and current-prefix-arg (maplev-cmaple--clear-buffer))
+      (maplev-cmaple--send-string (maplev--cmaple-process)
+                                  (buffer-substring-no-properties beg end)))))
+
+(defun maplev-cmaple-send-line ()
+  "Send the current line to cmaple"
+  (interactive)
+  (maplev-cmaple-send-region (line-beginning-position) (line-end-position)))
+
+(defun maplev-cmaple-send-buffer ()
+  "Send the buffer to cmaple."
+  (interactive)
+  (maplev-cmaple-send-region (point-min) (point-max)))
+
+(defun maplev-cmaple-send-procedure ()
+  "Send the current procedure to cmaple."
+  (interactive)
+  (apply 'maplev-cmaple-send-region (maplev-current-defun)))
+
+(defun maplev-cmaple-direct (input &optional delete)
+  "Send the string INPUT to cmaple and return the output.
+If optional argument DELETE is non-nil, delete the echoed Maple input
+from the output buffer.  This is a very simple function, it assumes
+that the input consists of one line and the output is on the following line."
+  ;; This may not work on a Windows box; there, the input is not echoed
+  ;; to the output buffer.
+  (interactive)
+  ;; (while (maplev-cmaple--locked-p) (maplev--short-delay))
+  (maplev-cmaple--wait)
+  (save-current-buffer
+    (let ((proc (maplev--cmaple-process))) ; ensure Maple is started
+      (set-buffer (maplev--cmaple-buffer))
+      (save-restriction
+        (narrow-to-region (point-max) (point-max))
+        (maplev-cmaple--send-string proc input)
+        ;; (while (maplev-cmaple--locked-p) (maplev--short-delay))
+        (maplev-cmaple--wait)
+        (goto-char (point-min))
+        (forward-line)
+        (let ((output (buffer-substring-no-properties
+                       (line-beginning-position) (line-end-position))))
+          (if delete
+              (delete-region (point-min) (point-max)))
+          output)))))
+      
+(defun maplev-cmaple--send-end-notice (process)
+  "Send a command to PROCESS \(cmaple\) to print `maplev-cmaple-end-notice'."
+  (comint-simple-send process (concat "lprint(" maplev-cmaple-end-notice ");")))
+
+(defun maplev-cmaple--ready (process)
+  "Return t if PROCESS \(cmaple\) is ready for new input, nil otherwise.
+Remove `maplev-cmaple-end-notice' from the current buffer.
+Reset the filter for PROCESS \(cmaple\) and unlock access."
+  (let (case-fold-search)
+    (save-excursion
+      (when (re-search-backward
+             (concat maplev-cmaple-end-notice "\n") nil t)
+        (delete-region (match-beginning 0) (match-end 0))
+        (when (and maplev-cmaple-echoes-flag
+                   (re-search-backward
+                    (concat "lprint(" maplev-cmaple-end-notice ");\n")
+                    nil t))
+          (delete-region (match-beginning 0) (match-end 0)))
+        (maplev--cleanup-buffer)
+        (set-process-filter process 'maplev--cmaple-filter)
+        (maplev-cmaple--unlock-access)
+        t))))
+
+(defun maplev-cmaple-interrupt ()
+  "Interrupt Maple."
+  (interactive)
+  (let ((process (get-buffer-process (maplev--cmaple-buffer))))
+    (message "Interrupt process %s" (process-name process))
+    (interrupt-process process)
+    (maplev-cmaple--unlock-access)))
+
+(defun maplev-cmaple-kill ()
+  "Kill Maple."
+  (interactive)
+  (let ((process (get-buffer-process (maplev--cmaple-buffer))))
+    (message "Kill process %s" (process-name process))
+    (kill-process process)))
+
+(defun maplev-cmaple--clear-buffer ()
+  "Clear the contents of the cmaple buffer."
+  (with-current-buffer (maplev--cmaple-buffer)
+    (delete-region (point-min) (point-max))))
+                 
+
+(defun maplev-cmaple-pop-to-buffer (&optional release)
+  "Pop up a buffer with command line Maple.  Start Maple, if necessary.
+Optional arg RELEASE defaults to `maplev-release'."
+  (interactive
+   (list (if current-prefix-arg
+             (completing-read "Maple release: "
+                              (mapcar (lambda (item) (list (car item)))
+                                      maplev-executable-alist)
+                              nil t))))
+  (unless release (setq release maplev-release))
+  (let ((maplev-release release))
+    (maplev--cmaple-process)
+    (pop-to-buffer (maplev--cmaple-buffer))
+    (goto-char (point-max))))
+
+(defalias 'cmaple 'maplev-cmaple-pop-to-buffer)
+
+(defun maplev--cmaple-filter (process string)
+  "Send the Maple output to the Maple buffer.
+PROCESS is the Maple process, STRING its output."
+  (with-current-buffer (process-buffer process)
+    (let ((pmark (process-mark process)))
+      (save-excursion
+        (save-restriction
+          (goto-char pmark)
+          (narrow-to-region (point) (point))
+          (insert string)
+          (maplev--cleanup-buffer)
+          (goto-char (point-max))
+          (set-marker pmark (point)))
+        (when (maplev-cmaple--ready process)
+          (insert maplev-cmaple-prompt)
+          (set-marker pmark (point))))
+      (goto-char pmark))))
+
+(defun maplev--cleanup-buffer ()
+  "Remove overstriking and underlining from the current buffer."
+  (goto-char (point-min))
+  (while (re-search-forward "\e\\[[0-9;]+m" nil t) (replace-match ""))
+  (goto-char (point-min))
+  (while (re-search-forward "\r+" nil t) (replace-match "\n")))
+
+;;}}}
+;;{{{   mode map
+
+(defvar maplev-cmaple-map nil
+  "Keymap used in Maple cmaple mode.")
+
+(unless maplev-cmaple-map
+  (let ((map (copy-keymap comint-mode-map)))
+    (define-key map [(return)]                'maplev-cmaple-send)
+    (define-key map [(control c) (control c)] 'maplev-cmaple-interrupt)
+    (define-key map [?\?]                     'maplev-help-at-point)
+    (define-key map [(control ?\?)]           'maplev-help-at-point)
+    (define-key map [(meta ?\?)]              'maplev-proc-at-point)
+    (define-key map [(meta tab)]              'maplev-complete-symbol)
+    (define-key map [(control a)]             'comint-bol)
+
+    ;; These two bindings are needed only under linux / unix
+    (define-key map [(meta control y)]    'maplev-insert-cut-buffer)
+
+    ;; mouse button bindings
+    (define-key map (maplev--mouse-keymap '(control meta 2))  'maplev-mouse-yank-cut-buffer)
+    (define-key map (maplev--mouse-keymap '(shift 2))         'maplev-help-follow-mouse)
+    (define-key map (maplev--mouse-keymap '(control shift 2)) 'maplev-help-follow-mouse)
+    (define-key map (maplev--mouse-keymap '(meta shift 2))    'maplev-proc-follow-mouse)
+
+    ;; in comint-mode-map of emacs 21, `C-c C-s' is bound to comint-write-output.
+    ;; Remove it so that it can be used as a prefix key to switch buffers.
+    (define-key map [(control c) (control s)]     nil)
+    (define-key map [(control c) (control s) ?h] 'maplev-switch-buffer-help)
+    (define-key map [(control c) (control s) ?l] 'maplev-switch-buffer-proc)
+    (define-key map [(shift return)]             'newline)
+    (setq maplev-cmaple-map map)))
+
+;;}}}
+;;{{{   mode
+
+(defconst maplev-input-line-keyword
+  `((,(concat "^" maplev-cmaple-prompt ".*$") . maplev-input-face))
+  "Keyword for font locking input lines in cmaple mode.")
+
+(defun maplev-cmaple-mode (&optional release)
+  "Major mode for interacting with cmaple.
+RELEASE is the release of Maple that should be started, if nil the
+`maplev-default-release' is used.  It has the same commands as
+`comint-mode' plus some additional commands for interacting with
+cmaple.
+
+\\{maplev-cmaple-map}"
+  (interactive)
+  (comint-mode)
+  (setq comint-prompt-regexp (concat "^\\(" maplev-cmaple-prompt "\\)+ *")
+        ;; GNU Emacs 21
+        comint-eol-on-send t
+        major-mode 'maplev-cmaple-mode
+        mode-name "Maple")
+  (if (< emacs-major-version 22)
+      ;; This generates a compiler warning.  Ignore.
+      (with-no-warnings
+	(setq comint-use-prompt-regexp-instead-of-fields t))
+    (setq comint-use-prompt-regexp t))
+
+  ;; Mint support
+  (make-local-variable 'maplev-mint--code-beginning)
+  (make-local-variable 'maplev-mint--code-end)
+
+  (maplev-set-release release)
+  (use-local-map maplev-cmaple-map)
+  (set (make-local-variable 'font-lock-defaults)
+       '(maplev-input-line-keyword))
+  (set (make-local-variable 'comint-process-echoes)
+       maplev-cmaple-echoes-flag)
+  (make-local-variable 'maplev-cmaple-prompt)
+  (font-lock-mode 1)
+  (run-hooks 'maplev-cmaple-mode-hook))
+
+;;}}}
+
+;;}}}
+
+;;{{{ Help mode
+
+;;{{{   mode map
+
+(defvar maplev-help-mode-map nil
+  "Keymap used in `maplev-help-mode'.")
+
+(unless maplev-help-mode-map
+  (let ((map (make-sparse-keymap)))
+;;    (define-key map [(SPC)]                      'scroll-up)
+    (define-key map (read-kbd-macro "SPC")       'scroll-up)
+    (define-key map [(backspace)]                'scroll-down)
+    (define-key map [?q]                         'quit-window)
+    (define-key map [?s]                         'isearch-forward)
+    (define-key map [?r]                         'maplev-history-redo-item)
+    (define-key map [?p]                         'maplev-history-prev-item)
+    (define-key map [?n]                         'maplev-history-next-item)
+    (define-key map [?d]                         'maplev-history-delete-item)
+    (define-key map [?P]                         'maplev-help-parent)
+    (define-key map [?\?]                        'maplev-help-at-point)
+    (define-key map [(control ?\?)]              'maplev-help-at-point)
+    (define-key map [(meta ?\?)]                 'maplev-proc-at-point)
+    (define-key map [?f]                         'maplev-tear-off-window)
+    (define-key map [(control c) (control s) ?h] 'maplev-switch-buffer-help)
+    (define-key map [(control c) (control s) ?l] 'maplev-switch-buffer-proc)
+    (define-key map [(control c) (control s) ?c] 'maplev-switch-buffer-cmaple)
+    (define-key map [(control c) (control c)]    'maplev-help-reset-help)
+    (define-key map [?h]                         'maplev-switch-buffer-help) ; short-cut
+    (define-key map [?l]                         'maplev-switch-buffer-proc) ; short-cut
+    (define-key map [?c]                         'maplev-switch-buffer-cmaple) ; short-cut
+    (define-key map [(return)]                   'maplev-help-at-point)
+    (define-key map [(meta return)]              'maplev-proc-at-point)
+
+    ;; Bind mouse buttons
+    (define-key map (maplev--mouse-keymap '(2))               'maplev-help-follow-mouse)
+    (define-key map (maplev--mouse-keymap '(shift 2))         'maplev-help-follow-mouse)
+    (define-key map (maplev--mouse-keymap '(control shift 2)) 'maplev-help-follow-mouse)
+
+    (define-key map (maplev--mouse-keymap '(meta 2))          'maplev-proc-follow-mouse)
+    (define-key map (maplev--mouse-keymap '(meta shift 2))    'maplev-proc-follow-mouse)
+
+    (setq maplev-help-mode-map map)))
+
+(defvar maplev-help-mode-menu nil)
+(unless maplev-help-mode-menu
+  (easy-menu-define
+    maplev-help-mode-menu maplev-help-mode-map
+    "Menu for Maple help and proc buffer."
+    `("MapleV"
+      ["Parent"         maplev-help-parent
+       :included (eq major-mode 'maplev-help-mode)]
+      ["Previous"       maplev-history-prev-item t]
+      ["Next"           maplev-history-next-item t]
+      ["Redraw"         maplev-history-redo-item t]
+      ["Delete"         maplev-history-delete-item t]
+      ["Goto help node" maplev-help-at-point t]
+      ["Goto proc node" maplev-proc-at-point t]
+      ["Clear history"  maplev-history-clear t]
+      "---"
+      ["Separate frame" maplev-tear-off-window
+       :active (not (one-window-p t 'here))]
+      "---"
+      ("Decoration" :included (eq major-mode 'maplev-proc-mode)
+       ,@maplev--menu-decoration))))
+
+;;}}}
+;;{{{   mode definition
+
+(defun maplev-help-mode (&optional release)
+  "Major mode for displaying Maple help pages.
+RELEASE is the Maple release, if nil, `maplev-default-release' is used.
+
+\\{maplev-help-mode-map}"
+  (interactive)
+  (kill-all-local-variables)
+  (setq major-mode 'maplev-help-mode) ;; needed by maplev-set-release
+  (maplev-set-release release)
+  (setq mode-name (format "Maple-Help %s" maplev-release))
+  (use-local-map maplev-help-mode-map)
+  (set (make-local-variable 'maplev--process-item)
+       (function maplev--help-process))
+
+  (make-local-variable 'maplev--history-stack) ; set up the stack
+  (maplev-history-clear)
+
+  ;; for maplev--activate-hyperlinks
+  (set (make-local-variable 'parse-sexp-lookup-properties) t)
+
+  (maplev-help-fontify-node)
+  (setq buffer-read-only t)
+  (run-hooks 'maplev-help-mode-hook))
+
+;;}}}
+;;{{{   mode functions
+
+(defun maplev-help-follow-mouse (click)
+  "Display the Maple help page of the topic at the mouse CLICK."
+  (interactive "e")
+  (set-buffer (window-buffer (event-window click)))
+  (goto-char (event-point click))
+  (let ((topic (maplev--ident-around-point))
+        (pkg (maplev-help--get-package)))
+    (if pkg
+        ;; This frequently works when the help index does not have a
+        ;; link to the particular help page; I understand that that is
+        ;; a deficiency only with the tty help for smaple.
+        (setq topic (format "%s,%s" pkg topic)))
+    (maplev-help-show-topic topic)))
+
+(defun maplev-help--get-package ()
+  "Check whether the help page is a package overview.
+If so, return the name of the package, otherwise return nil."
+  (save-excursion
+    (goto-char (point-min))
+    (let ((case-fold-search nil))
+      (and (looking-at "\\(?:Details\\|Overview\\) of the \\(\\w+\\) [Pp]ackage")
+           (match-string-no-properties 1)))))
+
+(defun maplev--ident-around-point (&optional default)
+  "Return the identifier around the point as a string.
+If it is empty use DEFAULT.
+If choice is empty, an error is signaled, unless DEFAULT equals \"\" or t."
+  ;; If point is in a string enclosed by backquotes,
+  ;; we take the whole string including the backquotes.
+  (let* ((state (parse-partial-sexp (maplev-safe-position)
+                                    (point)))
+         (choice (if (equal ?` (nth 3 state))
+                     ;; inside a string
+                     (buffer-substring-no-properties
+                      (nth 8 state)
+                      (save-excursion (goto-char (nth 8 state))
+                                      (forward-sexp 1) (point)))
+                   (current-word))))
+    (if (string-equal choice "")
+        (cond ((stringp default)
+               default)
+              (default "")
+              ((error "Empty choice")))
+      choice)))
+
+(defun maplev-ident-around-point-interactive (prompt &optional default complete)
+  "Request Maple identifier in minibuffer, using PROMPT.
+Default is identifier around point. If it is empty use DEFAULT.
+Minibuffer completion is used if COMPLETE is non-nil."
+  ;; Suppress error message
+  (if (not default) (setq default t))
+  (let ((enable-recursive-minibuffers t)
+        (ident (maplev--ident-around-point default))
+        (maplev-completion-release maplev-release)
+        choice)
+    (setq prompt (concat prompt (unless (string-equal ident "")
+                                  (concat " (default " ident ")"))
+                         ": ")
+          choice (if complete
+                     (completing-read prompt 'maplev--completion
+                                      nil nil nil maplev-history-list ident)
+                   (read-string prompt nil maplev-history-list ident)))
+    ;; Are there situations where we want to suppress the error message??
+    (if (string-equal choice "")
+        (error "Empty choice"))
+    (maplev--string-to-name choice)))
+
+(defun maplev--string-to-name (name)
+  "Convert NAME to a valid Maple name. Add backquotes if needed."
+  ;; Do we need something more general to match a string that might
+  ;; require backquotes?
+  (when (string-match "/" name)
+    (if (not (string= "`" (substring name 0 1)))
+        (setq name (concat "`" name)))
+    (if (not (string= "`" (substring name -1)))
+        (setq name (concat name "`"))))
+  name)
+
+(defun maplev-help-at-point (topic)
+  "Display Maple help for TOPIC \(a string\).
+Interactively, default is word point is on."
+  (interactive (list (maplev-ident-around-point-interactive
+                      "Maple help topic" "help" t)))
+  (maplev-help-show-topic topic))
+
+(defun maplev-help-show-topic (topic &optional hide)
+  "Display Maple help for TOPIC \(a string\).
+Push TOPIC onto the local stack, unless it is already on the top.
+If optional arg HIDE is non-nil do not display buffer."
+  (save-current-buffer             ; maybe should be deeper (NEW!!!!!)
+    (let ((release maplev-release)) ;; we switch buffers!
+      (set-buffer (get-buffer-create (maplev--help-buffer)))
+      (unless (eq major-mode 'maplev-help-mode)
+        (maplev-help-mode release))
+      ;; Push TOPIC onto history stack
+      (maplev--history-stack-process topic hide))))
+
+;;(setq maplev-cmaple-screenheight 24)
+
+(defun maplev--help-process (topic)
+  "Display Maple help for TOPIC in `maplev--help-buffer'."
+  (let ((process (maplev--cmaple-process)))
+    (maplev-cmaple--lock-access)
+    (set-process-filter process 'maplev--help-filter)
+    (set-buffer (maplev--help-buffer))
+    (setq mode-line-buffer-identification (format "%-12s" topic))
+    (let (buffer-read-only)
+      (delete-region (point-min) (point-max)))
+;;    (comint-simple-send process (concat "?" topic))
+    (comint-simple-send process (format "interface('screenheight=infinity'):\n?%s" topic))
+    (maplev-cmaple--send-end-notice process)))
+;;    ;; TODO this doesn't quite work, it echos in the cmaple buffer
+;;     (maplev-cmaple-direct (concat "interface('screenheight'="
+;;                                (number-to-string maplev-cmaple-screenheight)
+;;                                "):"))))
+
+(defun maplev--help-filter (process string)
+  "Pipe the output of a help command into `maplev--help-buffer'.
+PROCESS calls this filter.  STRING is the output."
+  (with-current-buffer (maplev--help-buffer)
+    (save-excursion
+      (let (buffer-read-only)
+        (save-restriction
+          (goto-char (point-max))
+          (narrow-to-region (point) (point))
+          (insert string)
+          (maplev--cleanup-buffer))
+        (goto-char (point-max))
+        (if (maplev-cmaple--ready process)
+            (maplev-help--cleanup-buffer))))))
+
+(defun maplev-help--cleanup-buffer ()
+  "Cleanup Maple help pages."
+  (if maplev-cmaple-echoes-flag
+      (save-excursion
+        (goto-char (point-min))
+        ;; remove the echoed 'interface(screenheight=...) and ?topic lines
+        (when (looking-at "interface")
+          (forward-line)
+          (delete-region (point-min) (point)))
+        (if (re-search-forward "\\`\\?.+\n" nil t)
+            (delete-region (match-beginning 0) (match-end 0)))))
+  (maplev-help-fontify-node)
+  (set-buffer-modified-p nil))
+
+(defun maplev-switch-buffer-help ()
+  "Switch to help buffer, if it exists."
+  (interactive)
+  (maplev-switch-buffer (maplev--help-buffer)))
+
+(defun maplev-switch-buffer-proc ()
+  "Switch to proc buffer, if it exists."
+  (interactive)
+  (maplev-switch-buffer (maplev--proc-buffer)))
+
+(defun maplev-switch-buffer-cmaple ()
+  "Switch to cmaple buffer, if it exists."
+  (interactive)
+  (maplev-switch-buffer (maplev--cmaple-buffer)))
+
+(defun maplev-switch-buffer (buffer)
+  "Switch to BUFFER, if it exists."
+  (let ((buf (get-buffer buffer)))
+    (if buf
+        (switch-to-buffer buf)
+      (message "No buffer \"%s\"." buffer))))
+
+(defun maplev-help-to-source (code-only)
+  "Convert a help page to a Maple source file."
+  (interactive "P")
+  (let (buffer-read-only)
+    (goto-char (point-min))
+    (while (not (eobp))
+      (if (looking-at "> ")
+          (progn
+            (delete-char 2)
+            (forward-line))
+        (if (not code-only)
+            (progn
+              (insert "# ")
+              (forward-line))
+          (delete-region (point) (line-end-position))
+          (delete-char 1))))))
+
+(defun maplev-help-reset-help ()
+  "Reset the settings that affect the display of help pages."
+  (interactive)
+  (maplev-cmaple-direct (maplev--cmaple-get-init-string maplev-release) 'delete))
+
+;;}}}
+;;{{{   history mechanism
+
+(defun maplev-help-parent ()
+  "Display the parent node of the current help page.
+The parent node is extracted from the context of the help page, not
+from the parent defined in the Maple help system."
+  (interactive)
+  (goto-char (point-min))
+  (if (looking-at "\\(Function: ?\\)?\\([a-zA-Z0-9]*\\)\\[")
+      (maplev-help-show-topic (match-string 2))
+    (maplev-help-show-topic "index")))
+
+;;}}}
+;;{{{   fontify
+
+;;{{{     fonts
+
+(defcustom maplev-help-function-face 'font-lock-function-name-face
+  "Face name for functions in title lines of Maple help pages."
+  :type 'face
+  :group 'maplev-faces
+  :group 'maplev-help)
+
+(defvar maplev-help-title-face   'maplev-help-title-face
+  "*Face name for subtitles in title lines of Maple help pages.")
+
+(defvar maplev-help-section-face 'maplev-help-section-face
+  "*Face name for section titles in Maple help pages.")
+
+(defvar maplev-help-subsection-face 'maplev-help-section-face
+  "*Face name for section titles in Maple help pages.")
+
+(defvar maplev-input-face  'maplev-input-face
+  "*Face name for Maple input in help pages and Maple buffer.")
+
+(defface maplev-help-title-face
+  '((((class grayscale) (background light)) (:foreground "LightGray" :bold t))
+    (((class grayscale) (background dark))  (:foreground "DimGray"   :bold t))
+    (((class color)     (background light)) (:foreground "Black"     :bold t))
+    (((class color)     (background dark))  (:foreground "Green"     :bold t))
+    (t (:bold t)))
+  "Font lock mode face used to highlight subtitles in Maple help pages.
+The title is the phrase following the function name."
+  :group 'maplev-faces
+  :group 'maplev-help)
+
+(defface maplev-help-section-face
+  '((((class grayscale) (background light)) (:foreground "LightGray" :bold t))
+    (((class grayscale) (background dark))  (:foreground "DimGray"   :bold t))
+    (((class color)     (background light)) (:foreground "Red"       :bold t))
+    (((class color)     (background dark))  (:foreground "Red"       :bold t))
+    (t (:bold t)))
+  "Font lock mode face used to highlight section titles in Maple help pages."
+  :group 'maplev-faces
+  :group 'maplev-help)
+
+(defface maplev-help-subsection-face
+  '((((class grayscale) (background light)) (:foreground "LightGray" :bold t))
+    (((class grayscale) (background dark))  (:foreground "DimGray"   :bold t))
+    (((class color)     (background light)) (:foreground "orange"    :bold t))
+    (((class color)     (background dark))  (:foreground "orange"    :bold t))
+    (t (:bold t)))
+  "Font lock mode face used to highlight section titles in Maple help pages."
+  :group 'maplev-faces
+  :group 'maplev-help)
+
+(defface maplev-input-face
+  '((((class grayscale) (background light)) (:foreground "LightGray" :bold t))
+    (((class grayscale) (background dark))  (:foreground "DimGray"   :bold t))
+    (((class color)     (background light)) (:foreground "dark green"))
+    (((class color)     (background dark))  (:foreground "green"))
+    (t (:bold t)))
+  "Font lock mode face used to highlight Maple input."
+  :group 'maplev-faces
+  :group 'maplev-help)
+
+;;}}}
+;;{{{     regular expressions
+
+(defconst maplev--help-section-re
+  (concat "^\\(Calling Sequences?"
+          "\\|Parameters"
+          "\\|Description"
+          "\\|Examples"
+          "\\|See Also"
+          "\\|References"
+          "\\|Returns"
+          "\\|Notes"
+          "\\|Options"
+          "\\|Algorithm"
+          "\\|\\(?:List of \\([][a-zA-Z_]+ \\)?\\(Package\\|Subpackage\\|Module\\) Commands\\)"
+          "\\):?")
+  "Regular expression for sections in a Maple help page.")
+
+(defconst maplev--help-subsection-re
+  (concat "^\\([A-Z][a-z-0-9-]+ ?\\([A-Za-z0-9-][a-z]* ?\\)?"
+          "\\([A-Za-z][a-z-]*\\)?:?[ \t]*$"
+          "\\)")
+  "Regular expression for subsections in a Maple help page.")
+
+(defconst maplev--help-definition-re
+  "([ \t\n]*\\(Definition/[^) \t\n]+\\)[ \t\n]*)"
+  "Regular expression for dictionary hyperlinks")
+
+;;}}}
+;;{{{     functions
+
+(defun maplev-help-fontify-node ()
+  "Fontify a Maple help page buffer. Does not use font-lock mode."
+  (save-excursion
+    (let (buffer-read-only
+          (case-fold-search t))
+      (if font-lock-mode (font-lock-mode)) ; turn-off font-lock.
+
+      ;; Highlight the title.
+      ;; The tricky part is handling multiple titles.
+
+      (goto-char (point-min))
+      ;; Move to the end of the title area.  Stop at first section or bullet.
+      (if (re-search-forward (concat maplev--help-section-re "\\|^- ")
+                             nil 'move)
+          ;; Move backward to top of buffer, checking each line.
+          (while (= 0 (forward-line -1))
+            (if (looking-at "\\(Function:\\)?\\([^-\n]*\\)[ \t]+-[ \t]+\\(.*\\)$") ; regexp for function name(sort of)
+                (progn (and (match-beginning 1)
+                            (put-text-property (match-beginning 1) (match-end 1)
+                                               'face 'maplev-help-section-face))
+                       (and (match-beginning 3)
+                            (put-text-property (match-beginning 3) (match-end 3)
+                                               'face 'maplev-help-title-face))
+                       (and (match-beginning 2)
+                            (maplev--activate-hyperlinks (match-beginning 2) (match-end 2))))
+              (put-text-property (point) (progn (end-of-line) (point))
+                                 'face 'maplev-help-title-face)))
+        (goto-char (point-min))
+        (end-of-line)
+        (put-text-property (point-min) (point)
+                           'face 'maplev-help-title-face))
+
+      ;; Highlight subsection titles
+      (goto-char (point-min))
+      (while (re-search-forward maplev--help-subsection-re nil t)
+        (put-text-property (match-beginning 0) (match-end 0)
+                           'face 'maplev-help-subsection-face))
+
+
+      ;; Highlight functions in a package. This usually works.  It
+      ;; searches for `- The functions [arbitrary text] are:' and
+      ;; highlights everything from the colon to the next line that
+      ;; starts with a character that is not whitespace.
+      (goto-char (point-min))
+      (when (re-search-forward
+             "^- The\\( available\\)? \\(functions\\|routines\\)[^\n]* are\\( the following\\)?: *$"
+             nil 'move)
+        (maplev--activate-hyperlinks
+         (point) (progn (re-search-forward "^[^ \t\n]" nil 'move)
+                        (line-end-position -1))))
+
+      ;; Highlight Maple input
+      (goto-char (point-min))
+      (while (re-search-forward "^> .*$" nil t)
+        (put-text-property (match-beginning 0) (match-end 0)
+                           'face 'maplev-input-face))
+
+      ;; Highligt Maple comments
+      (goto-char (point-min))
+      (while (re-search-forward "^# .*$" nil t)
+        (put-text-property (match-beginning 0) (match-end 0)
+                           'face 'font-lock-comment-face))
+                 
+
+
+      ;; Activate hyperlinks following "See Also".
+      ;; Stop when encountering a blank line.
+      (goto-char (point-max))
+      (and (re-search-backward "^See Also:?" nil 'move)
+           (maplev--activate-hyperlinks 
+            (match-end 0) 
+            (point-max)))
+
+
+      ;; Highlight section titles
+      (goto-char (point-min))
+      (while (re-search-forward maplev--help-section-re nil t)
+        (put-text-property (match-beginning 0) (match-end 0)
+                           'face 'maplev-help-section-face))
+
+
+      ;; Activate hyperlinks in text.  This is overly aggressive.
+      (goto-char (point-min))
+      (re-search-forward "^Description" nil t)
+      (while (re-search-forward "(\\([][a-zA-Z,]+\\))" nil 'move)
+        (save-excursion
+          (beginning-of-line)
+          (unless (looking-at "> ")
+            (maplev--activate-hyperlink (match-beginning 1) (match-end 1)))))
+                 
+
+      ;; Activate hyperlinks following "Multiple matches:".
+      (goto-char (point-min))
+      (and (re-search-forward "^Multiple matches found:" nil 'move)
+           (maplev--activate-hyperlinks (match-end 0) (point-max)))
+
+      ;; Active dictionary hyperlinks
+      (goto-char (point-min))
+      (while (re-search-forward maplev--help-definition-re nil 'move)
+        (let ((beg (match-beginning 1))
+              (end (match-end 1)))
+          ;;(put-text-property beg end 'mouse-face 'highlight)
+          ;;(put-text-property beg end 'face maplev-help-function-face))))))
+          (maplev--activate-hyperlink beg end))))))
+
+(defun maplev--activate-hyperlinks (beg end)
+  "Font lock and activate Maple keywords in the region from BEG to END."
+  (goto-char beg)
+  (while (re-search-forward
+          (concat  maplev--name-re
+                   "\\([,/]" maplev--name-re "\\)*")
+          end 'move)
+    (let ((beg (match-beginning 0))
+          (end (match-end 0)))
+      ;; Treat everything between beg and end as word constituents.
+      ;; In particular, ignore the syntactic meaning of, e.g., `[',
+      ;; `]', and `,'. Thus we can use current-word to pick up
+      ;; these Maple keywords.
+      (maplev--activate-hyperlink beg end))))
+
+(defun maplev--activate-hyperlink (beg end)
+  "Font lock and activate text in region from BEG to END."
+  (put-text-property beg end 'syntax-table '(2 . nil))
+  (put-text-property beg end 'mouse-face 'highlight)
+  (put-text-property beg end 'face maplev-help-function-face))
+
+;;}}}
+
+;;}}}
+
+;;}}}
+;;{{{ Proc mode
+
+;;{{{   mode map
+
+;; The mode map for maplev-proc-map is identical to that for
+;; maplev-help-mode, with one exception: the parent function is not
+;; needed, so its key is redefined to self-insert (which generates an
+;; error, as does any other insertion, because the buffer if
+;; read-only).
+
+(defvar maplev-proc-mode-map nil
+  "Keymap used in `maplev-proc-mode'.")
+
+(unless maplev-proc-mode-map
+  (let ((map (copy-keymap maplev-help-mode-map)))
+    (define-key map [?P] 'self-insert-command)
+    (setq maplev-proc-mode-map map)))
+
+;;}}}
+;;{{{   mode definition
+
+(defun maplev-proc-mode (&optional release)
+  "Major mode for displaying the source code of Maple procedures.
+RELEASE is the Maple release, if nil, `maplev-default-release' is used.
+
+\\{maplev-proc-mode-map}"
+  (interactive)
+  (kill-all-local-variables)
+
+  (setq major-mode 'maplev-proc-mode) ;; needed by maplev-set-release
+  (maplev-set-release release)
+  (setq mode-name (format "Maple-Proc %s" maplev-release))
+  (use-local-map maplev-proc-mode-map)
+
+  (set (make-local-variable 'maplev--process-item)
+       (function maplev--proc-process))
+
+  (make-local-variable 'maplev--history-stack) ; set up the stack
+  (maplev-history-clear)
+
+  ;; Mint support
+  (make-local-variable 'maplev-mint--code-beginning)
+  (make-local-variable 'maplev-mint--code-end)
+
+  ;; font-lock support
+  (make-local-variable 'font-lock-defaults)
+  (make-local-variable 'font-lock-maximum-decoration)
+  (maplev-reset-font-lock)
+
+  (setq buffer-read-only t)
+  (run-hooks 'maplev-proc-mode-hook))
+
+;;}}}
+;;{{{   functions
+
+;;; Define functions for displaying a Maple procedure from the Maple
+;;; library in a buffer.
+
+(defun maplev-proc-follow-mouse (click)
+  "Display the Maple procedure at the mouse CLICK."
+  (interactive "e")
+  (set-buffer (window-buffer (event-window click)))
+  (goto-char (event-point click))
+  (maplev--proc-show-topic (maplev--ident-around-point)))
+
+(defun maplev-proc-at-point (proc)
+  "Display the Maple procedure PROC.
+Request procedure name in minibuffer, using identifier at point as default."
+  (interactive (list (maplev-ident-around-point-interactive
+                      "Maple procedure" nil t)))
+  (maplev--proc-show-topic proc))
+
+(defun maplev--proc-show-topic (proc &optional hide)
+  "Display the Maple procedure PROC \(a string\).
+Push PROC onto the local stack, unless it is already on the top.
+If optional arg HIDE is non-nil do not display buffer."
+  ;; Do not try to display builtin procedures.
+  (if (assoc proc (mapcar 'list
+                          (cdr (assoc (maplev--major-release) 
+                                      maplev--builtin-functions-alist))))
+      (message "Procedure \`%s\' builtin." proc)
+    (save-current-buffer
+      (let ((release maplev-release)) ;; we switch buffers!
+        (set-buffer (get-buffer-create (maplev--proc-buffer)))
+        (unless (eq major-mode 'maplev-proc-mode)
+          (maplev-proc-mode release))
+        (maplev--history-stack-process proc hide)))))
+
+(defun maplev--proc-process (proc)
+  "Display the Maple procedure PROC \(a string\) in `maplev--proc-buffer'."
+  (let ((process (maplev--cmaple-process)))
+    (maplev-cmaple--lock-access)
+    (set-process-filter process 'maplev-proc-filter)
+    (set-buffer (maplev--proc-buffer))
+    (setq mode-line-buffer-identification (format "%-12s" proc))
+    (let (buffer-read-only)
+      (delete-region (point-min) (point-max))
+      (goto-char (point-min))
+      ;;(insert proc " := ")
+      )
+    (comint-simple-send process (concat "maplev_print(\"" proc "\");"))
+    (maplev-cmaple--send-end-notice process)))
+
+(defun maplev-proc-filter (process string)
+  "Pipe a Maple procedure listing into `maplev--proc-buffer'.
+PROCESS calls this filter.  STRING is the Maple procedure."
+  (with-current-buffer (maplev--proc-buffer)
+    (save-excursion
+      (let (buffer-read-only)
+        (save-restriction
+          (goto-char (point-max))
+          (narrow-to-region (point) (point))
+          (insert string)
+          (maplev--cleanup-buffer))
+        (goto-char (point-max))
+        (if (maplev-cmaple--ready process)
+            (maplev-proc-cleanup-buffer))))))
+
+(defun maplev-proc-cleanup-buffer ()
+  "Cleanup Maple procedure listings."
+  (save-excursion
+    (when maplev-cmaple-echoes-flag
+      (goto-char (point-min))
+      (if (re-search-forward "maplev_print(.+);\n" nil t)
+          (delete-region (match-beginning 0) (match-end 0))))
+    ;; Delete multiple spaces.
+    (goto-char (point-min))
+    (while (re-search-forward "[ \t][ \t]+" nil t)
+      (replace-match " "))
+    ;; terminate with `;'
+    (goto-char (point-max))
+    (skip-chars-backward " \t\n")
+;;    (insert ";")
+    )
+  (maplev-indent-buffer)
+  (set-buffer-modified-p nil)
+  (font-lock-fontify-buffer))
+
+;;}}}
+
+;;}}}
+;;{{{ Mint mode
+
+;;{{{   customizable variables
+
+(defcustom maplev-mint-coding-system 'undecided-dos
+  "Coding system used by Mint.  See `coding-system-for-read' for details."
+  :type '(choice (const undecided-dos) (const raw-text-unix) (symbol :tag "other"))
+  :group 'maplev-mint)
+
+(defcustom maplev-mint-query t
+  "Non-nil means query before correcting."
+  :type 'boolean
+  :group 'maplev-mint)
+
+(defcustom maplev-mint-process-all-vars nil
+  "Non-nil means process all variables in one step."
+  :type 'boolean
+  :group 'maplev-mint)
+
+(defcustom maplev-mint-include-dir nil
+  "Directory of mint include files.
+This should probably be a list of directories."
+  :type 'string
+  :group 'maplev-mint)
+
+;;}}}
+;;{{{   syntax table
+
+(defvar maplev-mint-mode-syntax-table nil
+  "Syntax table used in Maple mint buffer.")
+(unless maplev-mint-mode-syntax-table
+  (let ((table (make-syntax-table)))
+    (modify-syntax-entry ?[  "w"  table)
+                         (modify-syntax-entry ?]  "w"  table)
+    (modify-syntax-entry ?_  "w"  table)
+    (modify-syntax-entry ?/  "w"  table)
+    (modify-syntax-entry ?\` "\"" table) ; string quotes
+    (setq maplev-mint-mode-syntax-table table)))
+
+;;}}}
+;;{{{   mode map
+
+(defvar maplev-mint-mode-map nil
+  "Keymap used in Mint mode.")
+
+(unless maplev-mint-mode-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map [(space)]                     'scroll-up)
+    (define-key map [(backspace)]                 'scroll-down)
+    (define-key map [(return)]                    'maplev-mint-rerun)
+    (define-key map [(control c) (return) return] 'maplev-mint-rerun)
+    (define-key map [?q]                          'quit-window)
+    (define-key map [?s]                          'isearch-forward)
+    (define-key map [?r]                          'isearch-backward)
+    (define-key map (maplev--mouse-keymap '(2))   'maplev-mint-click)
+    (define-key map [(control c) (control c)]     'maplev-mint-handler)
+    (setq maplev-mint-mode-map map)))
+
+;;}}}
+;;{{{   menu
+
+(easy-menu-define maplev-mint-mode-menu maplev-mint-mode-map
+  "Menu for Mint buffer."
+  '("Mint"
+    ["Fix errors" maplev-mint-fix-errors :visible nil] ; not yet defined
+    ["Rerun mint" maplev-mint-rerun t]
+    ["Quit"       quit-window t]))
+
+;;}}}
+;;{{{   mode definition
+
+(defun maplev-mint-mode (code-buffer)
+  "Major mode for displaying Mint output.
+CODE-BUFFER is the buffer that contains the source code.
+\\{maplev-mint-mode-map}"
+  (interactive)
+  (kill-all-local-variables)
+  (use-local-map maplev-mint-mode-map)
+  (setq major-mode 'maplev-mint-mode
+        mode-name "Mint")
+  (set-syntax-table maplev-mint-mode-syntax-table)
+  (set (make-local-variable 'maplev-mint--code-buffer) code-buffer)
+  (maplev-mint-fontify-buffer)
+  (setq buffer-read-only t)
+  (run-hooks 'maplev-mint-mode-hook))
+
+;;}}}
+;;{{{   mode functions
+
+(defun maplev-mint--goto-source-pos (l c &optional file)
+  "Move to position in source file and return position.
+If FILE is nil, use buffer `maplev-mint--code-buffer'.
+Pop up the buffer, move to either `point-min', if FILE is non-nil,
+or `maplev-mint--code-beginning' otherwise,
+and move forward L lines and C columns."
+  (pop-to-buffer (if file (find-file-noselect file)
+                   maplev-mint--code-buffer))
+  (goto-char (if file (point-min)  maplev-mint--code-beginning))
+  (if (> l 0) (forward-line l))
+  (forward-char c)
+  (point))
+
+(defun maplev-mint--goto-error (pos)
+  "Go to error in Maple source according to Mint message at position POS.
+Return position of error in Maple source."
+  (let (line col)
+    (save-excursion
+      (goto-char pos)
+      ;; The location of the error is indicated by the caret
+      ;; in the Mint output.
+      (when (re-search-backward "\\^" (line-beginning-position) t)
+        (setq col (current-column))
+        (forward-line -1)
+        (re-search-forward  "[0-9]+")
+        (setq line (1- (string-to-number (match-string 0)))
+              col  (- col (current-column) 2))))
+    (maplev-mint--goto-source-pos line col)))
+
+(defun maplev-mint--goto-source-proc-old (pos)
+  "According to Mint buffer position POS, move point to the end of the
+initial assignment statement of a source procedure/module.  This would
+be either the closing parenthesis of the formal parameter list, or the
+terminating semicolon or colon of an optional procedure/module type
+declaration.  Return non-nil if this is a procedure, nil if an operator.
+
+THIS NEEDS WORK TO HANDLE OPERATORS."
+  ;; This function uses a fairly complicated regexp in an attempt to
+  ;; match the appropriate procedure assignment.  In one sense this is
+  ;; overkill; Mint indicates the line number of the start of the
+  ;; procedure, so we should be able to go directly to the procedure on
+  ;; that line.  It is possible, however, to have a nested procedure on
+  ;; the same line as another procedure.  More to the point, a nested
+  ;; anonymous procedure inside an anonymous procedure. In that case the
+  ;; only distinction is the argument list.  Does this happen enough to
+  ;; justify this code?   If we merely desire to move point to the
+  ;; correct place in the source, getting to the right line is
+  ;; sufficient.  But if there is some automated work to do, the exact
+  ;; point is required.  One way to avoid this complexity is to not
+  ;; offer the user the option of automatically adding or deleting
+  ;; variables from an anonymous procedure.  The sticking point is that
+  ;; Mint, alas, considers indexed names to be anonymous procedures so
+  ;; their frequency is greater than should be.
+
+  (let (name-re args-re line case-fold-search)
+    (save-excursion
+      (goto-char pos)
+      (re-search-backward "^\\(Nested \\)?\\(Anonymous \\)?\\(Procedure\\|Operator\\|Module\\)")
+      ;; Assign name-re the procedure/module name.
+      (setq name-re (if (nth 4 (match-data)) ; t if anonymous procedure
+                        ""
+                      (save-excursion
+                        ;; Use `(' to terminate proc-name
+                        ;; (re-search-forward "\\(Procedure\\|Module\\)[ \t]*\\([^(]*\\)")
+                        (re-search-forward "\\(Procedure\\|Module\\)\\s-*\\([^[(]*\\)")
+                        (concat "`?" (match-string-no-properties 2)
+                                "\\([ \t\f\n]*\\[[^]]*\\]\\)*" ; optional indices
+                                "[ \t\n]*:=[ \t\n]*")))
+            ;; Assign a regular expression that matches the argument
+            ;; list in the source. The generated regexp does not
+            ;; match an argument list with duplicate arguments; this
+            ;; because Mint does not print the duplicate arguments.
+            ;; This can be improved, made more robust.
+            ;; Allow comments before commas, too.
+            args-re (save-excursion
+                      (re-search-forward "(\\([^)]*\\))")
+                      (maplev--replace-string
+                       (match-string-no-properties 1)
+                       `(("::" . " :: ")
+                         ("[ \t\n]+" . "[ \t\n]*")
+                         ("," . ,(concat "\\([ \t]*\\(#.*\\)?\n\\)*[ \t]*"
+                                         ","
+                                         "\\([ \t]*\\(#.*\\)?\n\\)*[ \t]*")))))
+            ;; Assign a regular expression that matches any argument
+            ;; list.  This may be tougher than I envisioned.  How are
+            ;; optional type declarations handled?  The difficulty is
+            ;; that they could have commas and closing parentheses.
+            
+            ;;            args-re (concat "\\s-*\\<\\w+\\>\\(\\s-*::\\s-*[^
+            )
+      (re-search-forward "on\\s-*lines?\\s-*\\([0-9]+\\)")
+      (setq line (1- (string-to-number (match-string 1)))))
+    
+    ;; move point in source to beginning of line where procedure/module assignment begins.
+
+    (maplev-mint--goto-source-pos line 0)
+
+    ;; move forward to end of assignment.
+
+    (unless (re-search-forward (concat name-re
+                                       "\\(proc\\|module\\)[ \t\n*]*"
+                                       "(\\([ \t]*\\(#.*\\)?\n\\)*"
+                                       args-re
+                                       "\\([ \t\n]*#.*$\\)*[ \t\n]*)"
+                                       "\\(\\s-*::\\s-*\\<\\w+\\>\\s-*[;:]\\)?" ; optional procedure type
+                                       )
+                               nil t)
+      ;; If search failed (possibly because of duplicate arguments,
+      ;; try again without explicitly specifying the argument list.
+      (goto-char (maplev--scan-lists 1)))))
+
+
+
+(defun maplev-mint--goto-source-proc (pos)
+  "According to Mint buffer position POS, move point to the end of the
+initial assignment statement of a source procedure/module.  This would
+be either the closing parenthesis of the formal parameter list, or the
+terminating semicolon or colon of an optional procedure/module type
+declaration.  Return non-nil if this is a procedure, nil if an operator."
+
+  ;; find the line number of the source buffer at which the defun starts
+  (goto-char pos)
+  (re-search-backward "^\\(Nested \\)?\\(Anonymous \\)?\\(Procedure\\|Operator\\|Module\\)")
+  (re-search-forward "on\\s-*lines?\\s-*\\([0-9]+\\)")
+  ;; move point to the beginning of that line in the source
+  (maplev-mint--goto-source-pos 
+   (1- (string-to-number (match-string 1)))
+   0
+   ;; Optional file name, if applicable.
+   ;; If looking at something like " to 123 in filename", then
+   ;; the source is in filename, which is relative to the
+   ;; mint includedir.  Search for that file, using first the current
+   ;; directory, then maplev-mint-include-dir.
+   (when (looking-at "\\s-+to\\s-+\\(?:[0-9]+\\)\\s-+of\\s-+\\(.*\\)$")
+     (let* ((base (match-string 1))
+            (file (if (file-exists-p base) 
+                      base
+                    (concat (file-name-as-directory maplev-mint-include-dir) base))))
+       (if (not (file-readable-p file))
+           (error (concat "File " file " does not exist or is unreadable"))
+         file))))
+  ;; move to the end of the defun opening statement
+  (re-search-forward ":=")
+  (goto-char (maplev--scan-lists 1))
+  (if (looking-at "\\s-*::[^;:]+[;:]") (goto-char (match-end 0))))
+
+(defun maplev-mint--goto-source-line (pos)
+  "Find the line number in the Mint buffer at position POS, then move
+point to that line in the source buffer."
+  (goto-char pos)
+  (beginning-of-line)
+  (re-search-forward "line \\([0-9]+\\)" (line-end-position))
+  (maplev-mint--goto-source-pos (1- (string-to-number (match-string 1))) 0))
+
+
+(defun maplev--replace-string (string replace)
+  "In STRING replace as specified by REPLACE.
+REPLACE is an alist with elements \(OLD . NEW\)."
+  (while replace
+    (let ((pos 0)
+          (old (caar replace))
+          (new (cdar replace)))
+      (while (and (< pos (length string))
+                  (setq pos (string-match old string pos)))
+        (setq string (replace-match new t t string)
+              pos (+ pos (length new)))))
+    (setq replace (cdr replace)))
+  string)
+
+;;}}}
+;;{{{   fontify
+
+(defcustom maplev-mint-proc-face 'font-lock-function-name-face
+  "Face name for procedure names in a Mint buffer."
+  :type 'face
+  :group 'maplev-faces
+  :group 'maplev-mint)
+
+(defcustom maplev-mint-warning-face 'font-lock-warning-face
+  "Face name for warnings in a Mint buffer."
+  :type 'face
+  :group 'maplev-faces
+  :group 'maplev-mint)
+
+(defcustom maplev-mint-error-face 'font-lock-warning-face
+  "Face name for error messages in a Mint buffer."
+  :type 'face
+  :group 'maplev-faces
+  :group 'maplev-mint)
+
+(defcustom maplev-mint-note-face 'font-lock-warning-face
+  "Face name for notes in a Mint buffer."
+  :type 'face
+  :group 'maplev-faces
+  :group 'maplev-mint)
+
+(defconst maplev-mint-variables-re
+  "[ \t\n]*\\(\\(.*,[ \t]*\n\\)*.*\\)[ \t]*$"
+  "Regexp used to match the argument list of procedures in Mint output.")
+
+(defconst maplev-mint-fontify-alist
+  '(("\\(^on line[ \t]*[0-9]+:\\)" maplev-mint-note-face)
+    ("^[ \t]*\\(\\^.*$\\)" maplev-mint-error-face 'error)
+    ("^\\(?:Nested \\)?\\(?:Procedure\\|Operator\\|Module\\)[ ]*\\([^(]*\\)" maplev-mint-proc-face 'proc)
+    ("^\\(?:Nested \\)?Anonymous \\(?:Procedure\\|Operator\\)[ ]*\\(proc([^)]*)\\)" maplev-mint-proc-face 'proc)
+    ("These parameters were never used\\(?: explicitly\\)?:" maplev-mint-warning-face 'unused-arg t)
+    ("These names appeared more than once in the parameter list:" maplev-mint-warning-face 'repeat-arg t)
+    ("These local variables were not declared explicitly:" maplev-mint-warning-face 'undecl-local t)
+    ("These local variables were never used:" maplev-mint-warning-face 'unused-local t)
+    ("These names were declared more than once as a local variable:" maplev-mint-warning-face 'repeat-local t)
+    ("These names were used as global names but were not declared:" maplev-mint-warning-face 'undecl-global t)
+    ("\\(on line [0-9]+\\)" maplev-mint-note-face 'goto-line)
+    ;; Could we make the following optional?
+    ;; ("Global names used in this procedure:"
+    ;;  1 maplev-mint-warning-face 'undecl-global t)
+    )
+  "Alist for fontification in a Mint buffer. Each element is a list of
+the form \(REGEXP FACE PROP VAR\), where REGEXP is to be matched and
+FACE is a face.  Optional third element PROP is a symbol used for
+marking the category of SUBEXP.  Optional fourth element VAR is
+non-nil if REGEXP is concatenated with `maplev-mint-variables-re'.")
+
+(defun maplev-mint-fontify-buffer ()
+  "Fontify the mint buffer. Does not use font-lock mode."
+  (let ((mlist maplev-mint-fontify-alist)
+        regexp mel buffer-read-only case-fold-search)
+    (if font-lock-mode (font-lock-mode)) ; turn-off font-lock
+    ;; Process elements of maplev-mint-fontify-alist
+    (while (setq mel (car mlist))
+      (goto-char (point-min))
+      (setq regexp (concat (nth 0 mel)
+                           (if (nth 3 mel) maplev-mint-variables-re)))
+      (while (re-search-forward regexp nil t)
+        (let ((beg (match-beginning 1))
+              (end (match-end 1)))
+          ;; Here we are working with variables whose values are symbols
+          ;; with a face property.
+          (put-text-property beg end 'face (eval (nth 1 mel)))
+          (when (nth 2 mel)
+            ;; We use a text property `maplev-mint' to store in the text
+            ;; what kind of info we have from Mint.
+            (put-text-property beg end 'maplev-mint (eval (nth 2 mel)))
+            (if (and (nth 3 mel)
+                     (not maplev-mint-process-all-vars)) ; then we do highlighting word-wise
+                (save-excursion
+                  (goto-char beg)
+                  ;; Slightly simpler algorithm than the one used by
+                  ;; maplev--ident-around-point to pick up the word
+                  ;; where point is. Does it matter for highlighting?
+                  ;;                   (while (re-search-forward "\\<\\w+\\>" end t)
+                  ;;                     (put-text-property (match-beginning 0) (match-end 0)
+                  ;;                                        'mouse-face 'highlight)))
+                  (while (re-search-forward "\\<\\(\\w+\\)\\>" end t)
+                    (put-text-property (match-beginning 1) (match-end 1)
+                                       'mouse-face 'highlight)))
+              (put-text-property beg end 'mouse-face 'highlight)))))
+      (setq mlist (cdr mlist)))
+    (set-buffer-modified-p nil)))
+
+;;}}}
+;;{{{   interactive functions
+
+(defun maplev-mint-click (click)
+  "Move point to CLICK."
+  (interactive "e")
+  (set-buffer (window-buffer (event-window click)))
+  (maplev-mint-handler (event-point click)))
+
+(defun maplev-mint-handler (pos)
+  "Handle mint output at position POS.
+When called interactively, POS is position where point is."
+  (interactive "d")
+  (let ((prop (get-text-property pos 'maplev-mint)))
+    (if prop
+        (let (string vars)
+          (if maplev-mint-process-all-vars
+              (let ((str (buffer-substring-no-properties
+                          (next-single-property-change pos 'maplev-mint)
+                          (previous-single-property-change (1+ pos) 'maplev-mint))))
+                ;; string is like str, but with maplev-variable-spacing
+                ;; vars is a comma separated list of names extracted from str
+                (while (and (not (string= str ""))
+                            (string-match "\\<\\w+\\>" str))
+                  (setq vars (cons (match-string 0 str) vars)
+                        string (if string
+                                   (concat string ","
+                                           (make-string maplev-variable-spacing ?\ )
+                                           (match-string 0 str))
+                                 (match-string 0 str))
+                        str (substring str (match-end 0)))))
+            (setq string (save-excursion
+                           (goto-char pos)
+                           (maplev--ident-around-point))
+                  vars (list string)))
+          ;;
+          (cond
+           ;; Jump to the start of a procedure in the source.
+           ((equal prop 'proc)
+            (maplev-mint--goto-source-proc pos))
+           ;;
+           ;; Jump to the location of an error in the source code.
+           ((equal prop 'error)
+            (maplev-mint--goto-error pos))
+           ;;
+           ;; Remove unused args from argument list.
+           ((equal prop 'unused-arg)
+            (when (maplev-mint-query "Delete `%s' from argument list? " string)
+              (maplev-mint--goto-source-proc pos)
+              (maplev-delete-vars (maplev--scan-lists -1) (point) vars)))
+           ;;
+           ;; Remove unused local variables from local declaration.
+           ((equal prop 'unused-local)
+            (when (maplev-mint-query "Delete `%s' from local statement? " string)
+              (maplev-mint--goto-source-proc pos)
+              (maplev-delete-declaration "local" vars)))
+           ;;
+           ;; Remove repeated args from argument list.
+           ((equal prop 'repeat-arg)
+            (when (maplev-mint-query "Remove duplicate `%s' from parameters? " string)
+              (maplev-mint--goto-source-proc pos)
+              (maplev-delete-vars (maplev--scan-lists -1) (point) vars 1)))
+           ;;
+           ;; Remove repeated local variables from local declaration.
+           ((equal prop 'repeat-local)
+            (when (maplev-mint-query "Remove duplicate `%s' from local statement? " string)
+              (maplev-mint--goto-source-proc pos)
+              (maplev-delete-declaration "local" vars 1)))
+           ;;
+           ;; Declaration of undeclared locals variables.
+           ((equal prop 'undecl-local)
+            (when (maplev-mint-query "Add `%s' to local statement? " string)
+              (maplev-mint--goto-source-proc pos)
+              (maplev-add-declaration "local" string)))
+           ;;
+           ;; Declaration of undeclared global variables.
+           ((equal prop 'undecl-global)
+            (when (maplev-mint-query "Add `%s' to global statement? " string)
+              (maplev-mint--goto-source-proc pos)
+              (maplev-add-declaration "global" string)))
+           ;;
+           ;; Goto line
+           ((equal prop 'goto-line)
+            (maplev-mint--goto-source-line pos))
+           )))))
+
+(defun maplev-mint-query (form &rest vars)
+  "Return t if correction suggested by mint should be made.
+FORM and VARS are used for y-or-n-p query."
+  (or (not maplev-mint-query)
+      (y-or-n-p (apply 'format form vars))))
+
+;;}}}
+;;{{{   regions
+
+(defun maplev-mint-region (beg end)
+  "Run Mint on the current region \(from BEG to END\).
+Return exit code of mint."
+  (interactive "r")
+  (let ((code-buffer (current-buffer))
+        (code-window (get-buffer-window (current-buffer)))
+        (coding-system-for-read maplev-mint-coding-system)
+        (mint-buffer (concat "*Mint " maplev-release "*"))
+        (mint (nth 2 (cdr (assoc maplev-release maplev-executable-alist))))
+	(include-path maplev-include-path)
+        status eoi lines errpos)
+    ;; Allocate markers, unless they exist
+    (unless maplev-mint--code-beginning
+      (setq maplev-mint--code-beginning (make-marker)
+            maplev-mint--code-end (make-marker)))
+    (set-marker maplev-mint--code-beginning beg)
+    (set-marker maplev-mint--code-end end)
+    (with-current-buffer (get-buffer-create mint-buffer)
+      (setq buffer-read-only nil))
+    (copy-to-buffer mint-buffer beg end)
+    (with-current-buffer mint-buffer
+      (goto-char (point-max))
+      ;; Add a blank line to the end of the buffer, unless there is
+      ;; one already.  This is needed for mint to work properly.
+      ;; (That's why mint-buffer is used as a temp buffer for mint input.)
+      (if (not (bolp)) (newline))
+      ;; remember end-of-input
+      (setq eoi (point-max))
+      ;; Run Mint
+      (setq status (apply 'call-process-region
+                          (point-min) (point-max)
+                          mint nil mint-buffer nil
+                          (concat "-i" (number-to-string maplev-mint-info-level)
+                                  ;; Add include path to argument list.
+                                  ;; Use commas to separate directories (see ?mint)
+                                  (and include-path
+                                       (concat " -s -I " 
+                                               (mapconcat 'identity include-path ","))))
+                          maplev-mint-start-options))
+      (delete-region (point-min) eoi)
+      ;; Display Mint output
+      (maplev-mint-mode code-buffer)
+      (setq lines (if (= (buffer-size) 0)
+                      0
+                    (count-lines (point-min) (point-max))))
+      (cond ((= lines 0)
+             ;; let's assume: no mint output means no "real" error
+             ;; This happens with maplev-mint-info-level set to 1
+             (setq status 0))
+            ((= lines 1)
+             (goto-char (point-min))
+             (message "%s" (buffer-substring-no-properties
+                            (point) (line-end-position))))
+            ((> lines 1)
+             (display-buffer (current-buffer))))
+      ;; If error in maple source (should be identical to status > 0)
+      ;; locate position of error
+      (goto-char (point-min))
+      (if (re-search-forward "^[ \t]*\\^" nil t)
+          (setq errpos (maplev-mint--goto-error (point)))))
+    ;; If there is an error in the maple source and a window displays it,
+    ;; move point in this window
+    (if (and code-window errpos)
+        (set-window-point code-window errpos))
+    status))
+
+(defun maplev-mint-buffer ()
+  "Run Mint on the current buffer."
+  (interactive)
+  (save-restriction
+    (widen)
+    (maplev-mint-region (point-min) (point-max))))
+
+(defun maplev-mint-procedure ()
+  "Run Mint on the current procedure."
+  (interactive)
+  (apply 'maplev-mint-region (maplev-current-defun)))
+
+(defun maplev-mint-rerun ()
+  "Rerun Mint on the previously executed region.
+If no region has been selected, run Mint on the buffer."
+  (interactive)
+  (save-current-buffer
+    (if maplev-mint--code-buffer        ; we are in mint buffer
+        (set-buffer maplev-mint--code-buffer))
+    (if (not maplev-mint--code-beginning)
+        (maplev-mint-buffer)
+      (maplev-mint-region (marker-position maplev-mint--code-beginning)
+                          (marker-position maplev-mint--code-end)))))
+
+;;}}}
+
+;;}}}
+;;{{{ History mechanism
+
+;; History of history.
+;;
+;; Originally this structure was implemented as a browsable stack.
+;; New entries were always inserted on the top.  The usage,
+;; however, seemed confusing.  Bringing up a new node while browsing
+;; the stack would move you to the top of the stack, away from where
+;; you were.
+;;
+;; The new design inserts entries where you are at.  An interesting
+;; modification, not implemented (yet) would be to make this a
+;; rolodex, that is, a ring rather than a stack.
+
+;;{{{   Module
+
+;; Implement a stack-like structure for providing a history mechanism
+;; for the Help and Proc modes.  The stack is a list.  The car of the
+;; list is an integer that indexes a particular element in the list;
+;; it is used when scrolling through the stack.
+
+(defvar maplev--history-stack nil
+  "List containing history of previous `commands'.
+The car of the list is an integer that indexes a particular element in
+the list, it is used to scroll through the stack.  This is a
+buffer-local variable associated with the Maple Help and Maple Proc
+output buffers.")
+
+(defun maplev--history-stack-insert (item)
+  "Put ITEM into `maplev--history-stack'."
+  (let ((pos (car maplev--history-stack)))
+    (setcdr (nthcdr pos maplev--history-stack)
+            (cons item (nthcdr (1+ pos) maplev--history-stack)))))
+
+(defun maplev--history-stack-prev ()
+  "Return the item on `maplev--history-stack' preceding the one last accessed.
+If at the bottom of the stack return nil, otherwise increment the pointer."
+  (let* ((pos (1+ (car maplev--history-stack)))
+         (item (nth pos (cdr maplev--history-stack))))
+    (when item
+      (setcar maplev--history-stack pos)
+      item)))
+
+(defun maplev--history-stack-next ()
+  "Return the item on `maplev--history-stack' following the one last accessed.
+If at the top of the stack, return nil, otherwise decrement the pointer."
+  (let ((pos (1- (car maplev--history-stack))))
+    (when (>= pos 0)
+      (setcar maplev--history-stack pos)
+      (nth pos (cdr maplev--history-stack)))))
+
+(defun maplev--history-stack-top ()
+  "Return the top item of `maplev--history-stack'.
+Do not change the pointer."
+  (nth 1 maplev--history-stack))
+
+(defun maplev--history-stack-current ()
+  "Return the currently accessed element of `maplev--history-stack'."
+  (nth (car maplev--history-stack) (cdr maplev--history-stack)))
+
+;;}}}
+;;{{{   Commands
+
+;;; The following commands process the history items.  The symbol
+;;; `maplev--process-item' should be buffer local and assigned the
+;;; name of the function that process the items.
+
+(defsubst maplev--process-item-func (item)
+  "Apply the function symbol `maplev--process-item' to ITEM."
+  (if (stringp item)
+      (funcall maplev--process-item item)
+    (message "End of stack")))
+
+(defun maplev-history-next-item ()
+  "Process the next item on `maplev--history-stack'."
+  (interactive)
+  (maplev--process-item-func (maplev--history-stack-next)))
+
+(defun maplev-history-prev-item ()
+  "Process the previous item on `maplev--history-stack'."
+  (interactive)
+  (maplev--process-item-func (maplev--history-stack-prev)))
+
+(defun maplev-history-redo-item ()
+  "Process the current item on `maplev--history-stack'."
+  (interactive)
+  (maplev--process-item-func (maplev--history-stack-current)))
+
+(defun maplev-history-delete-item ()
+  "Delete current item from `maplev--history-stack'."
+  (interactive)
+  (when maplev--history-stack
+    (let ((pos (car maplev--history-stack)))
+      (setcdr (nthcdr pos maplev--history-stack)
+              (nthcdr (+ 2 pos) maplev--history-stack))
+      (unless (nth pos (cdr maplev--history-stack))
+        (setcar maplev--history-stack (setq pos (1- pos))))
+      (if (>= pos 0)
+          (maplev--process-item-func (maplev--history-stack-current))
+        (kill-buffer nil)))))
+
+(defun maplev-history-clear ()
+  "Assign `maplev--history-stack' an empty stack."
+  (interactive)
+  (setq maplev--history-stack (list 0)))
+
+(defun maplev--history-stack-process (item &optional hide)
+  "Insert ITEM into `maplev--history-stack' and process it.
+Do not insert ITEM into the stack if it is already at the current
+or following position.
+If optional arg HIDE is non-nil do not display buffer."
+  (let ((pos (car maplev--history-stack)))
+    (unless (or (string= item (maplev--history-stack-current))
+                (and (/= pos 0)
+                     (string= item (nth pos maplev--history-stack))))
+      (maplev--history-stack-insert item))
+    (maplev--process-item-func item)
+    (unless hide
+      (let ((pop-up-frames maplev-pop-up-frames-flag))
+        (display-buffer (current-buffer) nil (not maplev-xemacsp))))))
+
+;;}}}
+
+;;}}}
+;;{{{ Frames
+
+;; The following is a slightly modified version of
+;; `mouse-tear-off-window' from mouse.el.
+
+(defun maplev-tear-off-window ()
+  "Delete the current window and create a new frame displaying its buffer."
+  (interactive)
+  (if (one-window-p t 'here)
+      (message "Only one window in frame.")
+    (let* ((window (selected-window))
+           (buf (window-buffer window))
+           (frame (make-frame)))
+      (select-frame frame)
+      (switch-to-buffer buf)
+      (delete-window window))))
+
+;;}}}
+
+
+(provide 'maplev)
+(provide 'maplev-mode)
+
+;;; maplev.el ends here
\ No newline at end of file
diff --git a/elisp/emacs-goodies-el/maplev.texi b/elisp/emacs-goodies-el/maplev.texi
new file mode 100644
index 0000000..4ff6b8b
--- /dev/null
+++ b/elisp/emacs-goodies-el/maplev.texi
@@ -0,0 +1,1501 @@
+\input texinfo
+
+@setfilename maplev
+@settitle MapleV Emacs Mode @value{VERSION}
+
+@set VERSION 2.27
+@set DATE June 2011
+
+@dircategory Emacs
+@direntry
+* MapleV: (maplev).       A GNU-Emacs mode for developing Maple code.
+@end direntry
+
+
+@include version.texi
+
+@iftex
+@tolerance 10000
+@end iftex
+
+@copying
+MapleV is a GNU Emacs major mode for developing source code for @w{Maple}, 
+a computer algebra system (CAS) marketed by @w{Waterloo Maple Inc}.
+In this manual @dfn{MapleV} refers to the Emacs major mode and
+@dfn{Maple} to the CAS.  MapleV is written entirely in Emacs-Lisp and is
+distributed under the GNU General Public License.
+
+This manual is for MapleV version @value{VERSION}.
+
+Copyright @copyright{} 2011, Joseph S. Riel
+
+@quotation
+Permission is granted to copy, distribute and/or modify this document
+under the terms of the GNU Free Documentation License, Version 1.3 or
+any later version published by the Free Software Foundation; with no
+Invariant Sections, with no Front-Cover texts, and with no Back-Cover
+Texts.  A copy of the license is included in the section entitled
+``GNU Free Documentation License.''
+@end quotation
+@end copying
+
+
+
+@setchapternewpage on
+
+@titlepage
+@title MapleV
+@subtitle A GNU Emacs Mode for Maple Developers
+@subtitle For MapleV Version @value{VERSION}
+@c @subtitle @value{UPDATED}
+  
+@author Joseph S.@ Riel
+@page
+@vskip 0pt plus 1filll
+Maple is a registered trademarks of Waterloo Maple Inc.@*
+
+Copyright @copyright{} 1999, 2010 Joseph S. Riel@*
+ 
+Permission is granted to make and distribute verbatim copies of
+this manual provided the copyright notice and this permission notice
+are preserved on all copies.
+
+@end titlepage
+@page
+
+
+@ifnottex
+@node top, Copying, (dir), (dir)
+@top MapleV
+
+@insertcopying
+@end ifnottex
+
+@menu
+* Copying::                     Conditions for copying and changing MapleV.
+* GNU Free Documentation License::  Copying this manual.
+* Introduction::                A brief tour of MapleV's features.
+* Basics::                      A few basics.
+
+Editing
+
+* Indentation::                 Indenting Maple code.
+* Font Lock::                   Syntactic highlighting of Maple code.
+* Comments::                    Command for adding and aligning comments.
+* Shortcuts::                   Abbreviations and templates.
+* Imenu support::               Creating a procedure index.
+* Miscellaneous features::      Useful editing features
+
+Processes
+
+* Mint::                        Syntax checking.
+* Maple::                       Running Maple as a standalone process.
+* Help pages::                  Displaying Maple help pages.
+* Procedures::                  Displaying procedures from the Maple libraries.
+
+Appendices
+
+* Installation::                Installing MapleV.
+* Evolution::                   Credits, Bugs, Enhancements.
+
+Indices
+
+* Key Index::                   
+* Function Index::              
+* Variable Index::              
+
+@detailmenu
+ --- The Detailed Node Listing ---
+
+Indentation
+
+* Indentation Commands::        Commands for inserting and aligning comments.
+* Customizing Indentation::     Variables that affect indentation.
+* Indentation Tricks::          Forcing and preventing indentation.
+* Indentation Details::         Overview of the indentation algorithm.
+
+Indentation Tricks
+
+* Forcing indentation::         Using parentheses to force indentation.
+* Preventing indentation::      Using continued comments to prevent indentation.
+
+Font Lock
+
+* Decoration level::            Selecting the decoration level.
+* Adding keywords::             Customizing the font lock patterns.
+* Display faces::               Setting the display faces.
+
+Shortcuts
+
+* Abbreviations::               Abbreviations for common Maple functions.
+* Templates::                   Inserting procedures and assignments.
+
+Abbreviations
+
+* Customizing Abbreviations::   
+
+Miscellaneous features
+
+* Include statements::          Active include statements
+
+Mint
+
+* Running mint::                Commands for sending code to Mint.
+* Mint mode::                   Mode for viewing the output of Mint.
+
+Maple
+
+* Running Maple::               Commands for sending code to the Maple engine.
+* Cmaple mode::                 Mode for interacting with Maple.
+
+Help pages
+
+* Displaying help pages::       Commands for displaying Maple help pages.
+* MapleV help mode::            Mode for viewing Maple help pages.
+
+Procedures
+
+* Displaying procedures::       Commands to display Maple procedures.
+* MapleV proc mode::            Mode for viewing Maple procedures.
+
+Installation
+
+* Compiling::                   Byte compiling MapleV.
+* Customizing::                 Customizing the installation.
+* Info documentation::          Installing the Info documentation.
+
+Evolution
+
+* Bugs::                        
+* Acknowledgments::             
+* Enhancements::                
+
+@end detailmenu
+@end menu
+
+@node Copying, GNU Free Documentation License, top, top
+@unnumbered Copying
+@cindex Copying
+@cindex Copyright
+@cindex GPL
+@cindex General Public License
+@cindex License
+@cindex Free
+@cindex Free software
+@cindex Distribution
+@cindex Right
+@cindex Warranty
+
+The programs currently being distributed that relate to MapleV consist
+of GNU Emacs Elisp files.  These programs are "free"; this means that
+everyone is free to use them and free to redistribute them on a free
+basis.  The MapleV-related programs are not in the public domain; they
+are copyrighted and there are restrictions on their distribution, but
+these restrictions are designed to permit everything that a good
+cooperating citizen would want to do.  What is not allowed is to try to
+prevent others from further sharing any version of these programs that
+they might get from you.
+
+Specifically, we want to make sure that you have the right to give
+away copies of the programs that relate to MapleV, that you receive
+source code or else can get it if you want it, that you can change these
+programs or use pieces of them in new free programs, and that you know
+you can do these things.
+
+To make sure that everyone has such rights, we have to forbid you to
+deprive anyone else of these rights.  For example, if you distribute
+copies of the MapleV related programs, 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 tell them their rights.
+
+Also, for our own protection, we must make certain that everyone finds
+out that there is no warranty for the programs that relate to MapleV.
+If these programs are modified by someone else and passed on, we want
+their recipients to know that what they have is not what we distributed,
+so that any problems introduced by others will not reflect on our
+reputation.
+
+The precise conditions of the licenses for the programs currently
+being distributed that relate to MapleV are found in the General Public
+Licenses that accompany them.
+
+
+
+
+
+@node GNU Free Documentation License, Introduction, Copying, top
+@unnumbered GNU Free Documentation License
+@include fdl.texi
+
+
+
+@node Introduction, Basics, GNU Free Documentation License, top
+@unnumbered Introduction
+@cindex Introduction
+
+@iftex
+MapleV is a GNU Emacs major mode for developing source code for @w{Maple
+V}, a computer algebra system (CAS) owned by @w{Waterloo Maple Inc}.  In
+this manual @dfn{MapleV} refers to the Emacs major mode and @dfn{Maple}
+to the CAS.  MapleV is written entirely in Emacs-Lisp and is distributed
+under the GNU General Public License.
+@end iftex
+
+Following is a brief tour of MapleV's major features.
+
+@heading Indentation
+
+Maple source code is grammatically indented, either as you enter it or
+all at once.  Customizable variables permit a limited control of the
+indentation style.  The default settings produce a result that is very
+close to the pretty printed output of Maple.
+
+@heading Font Lock
+
+Maple reserved words, special words, initial variables, builtin
+functions, and top-level procedure assignments are font locked.
+Comments and quotes are syntactically highlighted.  The amount of
+``decoration'' can be customized.
+
+@heading Comments
+
+Commands are provided for inserting and aligning Maple comments.
+Auto-filling can be enabled so that comments automatically wrap.
+
+@heading Shortcuts
+
+Abbreviations for common Maple words are defined and automatically
+expanded, if enabled.  A blank procedure template, including your
+copyright statement, can be inserted into the source.  It queries for
+the name of the procedure, optional arguments, and a description.
+
+@heading Mint interface
+
+All or portions of the buffer can be sent to @code{mint}, Maple's syntax
+checker.  The output is displayed in a buffer with a mode that
+highlights and activates warnings and error messages.  Clicking on the
+activated text either moves the cursor to the appropriate point in the
+source code or queries to automatically correct the error.
+
+@heading Maple interface
+
+All or portions of the buffer can be sent to the command line version of
+Maple, which is run in its own buffer.  You can work directly in that
+buffer to exercise the source code.
+
+@heading Online help
+
+Help pages from Maple help databases can be called up and displayed in a
+buffer.  The buffer has a mode that font locks section headings and
+provides commands for viewing other help pages and recalling previously
+visited pages.
+
+@heading Library procedures
+
+Procedures from Maple libraries can be displayed in a buffer.  They are
+font locked the same as in a MapleV buffer.  Commands are
+available for displaying other procedures and a history mechanism
+provides a convenient means to return to previously displayed
+procedures.
+
+@heading Multiple Maple releases
+
+At installation MapleV is configured to work with a default release of
+Maple.  You may also specify alternate releases of Maple.  A MapleV
+buffer can then be configured to work with a release different than the
+default; it will access the versions of Maple and Mint appropriate for
+the release.
+
+
+
+
+@node Basics, Indentation, Introduction, top
+@chapter Basics
+@cindex Top-level procedures
+@cindex Menubar
+
+For MapleV to properly locate, fontify, and index @dfn{top-level
+procedures}, that is, non-nested procedure assignments, the procedure
+name @emph{must} be flush left.  Indenting the buffer moves top-level
+procedures to the left margin.
+
+There are a few exceptional cases in which what should be top-level
+procedures are, in fact, not.  The primary example is a Maple script in
+which procedures are conditionally assigned.  See @ref{Preventing
+indentation}, for an illustration and a method to automatically indent
+these procedures to the left column.
+
+Most of the higher-level MapleV functions, those that do more than edit
+text, are available on the menubar.
+
+
+
+
+@node Indentation, Font Lock, Basics, top
+@comment  node-name,  next,  previous,  up
+@chapter Indentation
+@cindex Indentation
+
+Maple source code is indented according to its grammar.  The indentation
+can occur either as you enter the code or all at once; the latter action
+is useful when working with non-indented source code.  A grammatical
+error, typically an out of place keyword or parenthesis, generates an
+error and moves the cursor to the place where the error was detected.
+
+@menu
+* Indentation Commands::        Commands for inserting and aligning comments.
+* Customizing Indentation::     Variables that affect indentation.
+* Indentation Tricks::          Forcing and preventing indentation.
+* Indentation Details::         Overview of the indentation algorithm.
+@end menu
+
+
+@node Indentation Commands, Customizing Indentation, Indentation, Indentation
+@comment  node-name,  next,  previous,  up
+@section Commands
+
+@cindex Indentation commands
+@cindex Commands, indentation
+
+@kindex C-j
+@kindex C-c @key{TAB} @key{TAB}
+@kindex C-c @key{TAB} b
+@kindex C-c @key{TAB} p
+@kindex C-c @key{TAB} r
+
+@findex maplev-electric-tab
+@findex maplev-indent-newline
+@findex maplev-indent-buffer
+@findex maplev-indent-procedure
+@findex maplev-indent-region
+
+@table @kbd
+@item @key{TAB}
+Indent the current line (@code{maplev-electric-tab}).
+
+@item C-j
+Indent the current line, insert a new line, and indent that line
+(@code{maplev-indent-newline}).
+
+@item C-c @key{TAB} @key{TAB}
+@itemx C-c @key{TAB} b
+Indent the buffer (@code{maplev-indent-buffer}).
+
+@item C-c @key{TAB} p
+Indent a procedure (@code{maplev-indent-procedure}).
+
+@item C-c @key{TAB} r
+Indent the region (@code{maplev-indent-region}).
+
+@end table
+
+
+@node Customizing Indentation, Indentation Tricks, Indentation Commands, Indentation
+@comment  node-name,  next,  previous,  up
+@section Customizing
+@cindex Customizing indentation
+@cindex Indentation, customizing
+
+The following variables affect indentation:
+
+@vtable @code
+@item maplev-indent-level
+The amount a subblock is indented. The default is 4.
+
+@item maplev-indent-declaration
+The amount the Maple procedure declarations (@code{local},
+@code{global}, @code{option}, and @code{description}) are indented.  The
+default is 0.
+
+@item maplev-dont-indent-re
+A regex or nil.  If non-nil then lines that begin with a match are not
+indented.  The default, @samp{"#"}, prevents flush left comment lines
+from being indented.
+
+@end vtable
+
+
+@node Indentation Tricks, Indentation Details, Customizing Indentation, Indentation
+@section Indentation Tricks
+
+The indentation algorithm is not perfect.  It can fail to indent code
+that should be indented or it may indent code that should not be
+indented.  The following sections give examples and demonstrate workarounds.
+
+@menu
+* Forcing indentation::         Using parentheses to force indentation.
+* Preventing indentation::      Using continued comments to prevent indentation.
+@end menu
+
+
+@node Forcing indentation, Preventing indentation, Indentation Tricks, Indentation Tricks
+@subsection Forcing indentation
+@cindex Forcing indentation
+@cindex Indentation, forcing
+@cindex Indenting continued expressions
+@cindex Continued expression, indenting
+
+MapleV's indentation algorithm does not (currently) handle continued
+expressions.  It aligns continuations with the left most
+character in the preceding line.  In an assignment it is preferable to
+align with the right side of the assignment.  
+
+@subsubheading Problem
+
+Indenting the following code causes the continued line to be left
+aligned with the preceding line, as the following illustrates:
+
+@example
+---------- Buffer: foo ----------
+y := a + ( ... ) 
+     + b;@point{}
+---------- Buffer: foo ----------
+
+@key{TAB}
+   @result{}
+---------- Buffer: foo ----------
+y := a + ( ... ) 
++ b;@point{}
+---------- Buffer: foo ----------        
+@end example
+
+@subsubheading Solution
+
+Use extra parentheses to prevent the continuation line from being
+aligned with the opening column:
+
+@example
+---------- Buffer: foo ----------
+y := ( a + ( ... ) 
+       + b );
+---------- Buffer: foo ----------
+@end example
+
+
+@node Preventing indentation,  , Forcing indentation, Indentation Tricks
+@subsection Preventing indentation
+
+@subsubheading Problem
+
+Consider an installation script in which the procedures @samp{foo1} and
+@samp{foo2} are assigned only when the flag @code{assign_procs} is
+@samp{true}.  The following example shows what happens when the buffer
+is indented.
+
+@example
+@group
+---------- Buffer: foo ----------
+if assign_procs then
+foo1 := proc() ... end:
+foo2 := proc() ... end:
+fi:
+---------- Buffer: foo ----------
+
+@kbd{M-x maplev-indent-buffer}
+   @result{}
+---------- Buffer: foo ----------
+if assign_procs then
+    foo1 := proc() ... end:
+    foo2 := proc() ... end:
+fi:
+---------- Buffer: foo ----------
+@end group
+@end example
+
+
+Because @code{foo1} and @code{foo2} are no longer flush left they are
+not recognized as top-level procedures.  Their names are not properly
+font locked and MapleV commands that operate on top-level procedures do
+not work on them.
+
+@subsubheading Solution
+
+Because MapleV ignores comment continuations that Maple respects
+(@ref{Comments}), we can use the following technique to prevent
+@samp{foo1} and @samp{foo2} from being indented.
+
+@example
+@group
+---------- Buffer: foo ----------
+if assign_procs then       #\
+fi                         # @r{Maple does not see this line}
+foo1 := proc() ... end:
+foo2 := proc() ... end:
+#\
+if then                    # @r{Maple does not see this line}
+fi:
+---------- Buffer: foo ----------
+@end group
+@end example
+
+MapleV ignores the comment continuations and determines that each
+@code{if} statement is completed on the following line.  The procedures
+@code{foo1} and @code{foo2} are not indented.  Maple, however, continues
+the comments and so matches the initial @code{if} to the final
+@code{fi}; it ignores the dummy statements.
+
+
+
+
+@node Indentation Details,  , Indentation Tricks, Indentation
+@section Indentation Details
+@cindex Indentation details
+@cindex Details, indentations
+@cindex Indentation grammar
+@cindex Grammar, indentation
+@cindex Indenting, speed of
+@cindex Speed of, indenting
+
+A grammar table (@code{maplev--grammar-alist}) defines the grammar
+used to indent Maple code.
+
+MapleV parses the source to compute the appropriate indentation for each
+line.  To speed this process, information from the last parse is saved
+and reused.  This method allows it to indent entire buffers reasonably
+quickly; the largest file in the Maple R5 share library
+(@file{gdev.mpl}, 160K, by Bruno Salvy) took twelve seconds to indent on
+a PC running NTEmacs.  During editing, if the buffer is modified above
+the last indentation location then the indentation information is lost;
+consequently, you may occasionally notice small delays as the source is
+reparsed.
+
+
+
+@node Font Lock, Comments, Indentation, top
+@chapter Font Lock
+@cindex Font lock
+
+
+@menu
+* Decoration level::            Selecting the decoration level.
+* Adding keywords::             Customizing the font lock patterns.
+* Display faces::               Setting the display faces.
+@end menu
+
+
+@node Decoration level, Adding keywords, Font Lock, Font Lock
+@section Decoration level
+@cindex Font lock, decoration level
+@cindex Decoration level, font lock
+@cindex Maximum decoration, font lock
+
+@vindex font-lock-maximum-decoration
+@findex maplev-reset-font-lock
+
+The amount of syntactical highlighting, or ``decoration'', is controlled
+by the global variable @code{font-lock-maximum-decoration}, which you
+may set in your @file{.emacs} file.  @inforef{Font Lock,,emacs}, for
+information.  MapleV mode provides three levels of decoration:
+
+@enumerate
+@item 
+Comments, quotes, top-level procedure names and Maple reserved works
+are highlighted.
+
+@item 
+Everything in level 1 plus Maple special words, initial variables, and
+the ditto operators are highlighted.
+
+@item
+Everything in level 2 plus Maple builtin functions are highlighted.
+
+@end enumerate
+
+Execute @kbd{M-x maplev-reset-font-lock @key{RET} LEVEL @key{RET}} or
+use the menubar, @kbd{MapleV -> Setup -> Decoration}, to change the
+decoration in a MapleV buffer.  @code{LEVEL} is an integer from 1 to 3.
+
+
+
+@node Adding keywords, Display faces, Decoration level, Font Lock
+@section Adding keywords
+@cindex Font lock, adding keywords
+@cindex Keywords, font locking
+@cindex Customizing font lock keywords
+
+You can use the usual method to add new keywords to font lock in MapleV
+mode.  For example, the following snippet can be added to your
+@file{.emacs} file to font lock @samp{simplify} and @samp{printf} in
+MapleV mode.
+
+@example
+(font-lock-add-keywords 
+ 'maplev-mode
+ '(("simplify" . maplev-font-special-word-face)
+   ("printf"   . maplev-font-special-word-face)))
+@end example
+
+
+@node Display faces,  , Adding keywords, Font Lock
+@section Display faces
+@cindex Font lock, display faces
+@cindex Font lock, faces
+@cindex Faces, font lock
+@cindex Display faces, font lock
+
+@vtable @code
+@item maplev-special-word-face
+Display face used for Maple special words.  The special words are
+@samp{args}, @samp{nargs}, @samp{procname}, @samp{RootOf} and
+@samp{Float}.
+
+@item maplev-initial-variable-face
+Display face used for Maple initial variables.  These are
+@samp{Catalan}, @samp{true}, @samp{false}, @samp{FAIL}, @samp{infinity},
+@samp{Pi}, @samp{gamma}, @samp{integrate}, @samp{libname}, @samp{NULL},
+@samp{Order}, @samp{printlevel}, and @samp{lasterror}.
+
+@end vtable
+
+
+
+@node Comments, Shortcuts, Font Lock, top
+@chapter Comments
+
+@cindex Comments
+
+@kindex M-;
+@kindex C-x ;
+@kindex C-u - C-x ;
+@kindex M-q
+
+@findex indent-for-comment
+@findex set-comment-column
+@findex kill-comment
+@findex fill-paragraph
+
+@vindex comment-column
+@vindex fill-column
+
+
+MapleV uses standard Emacs commands to enter, align and fill Maple
+comments.  @inforef{Comments,,emacs}. The commands are reproduced here
+for convenience.
+
+@table @kbd
+@item M-; 
+Insert or align an inline comment (@code{indent-for-comment}).  The
+comment character is inserted at column @code{comment-column}.
+
+@item C-x ;
+Set comment column (@code{set-comment-column}).
+
+@item C-u - C-x ;
+Kill comment on current line (@code{kill-comment }).
+
+@item M-q
+Fill a comment (@code{fill-paragraph}).  Wrap lines at column
+@code{fill-column} and insert new comment characters, aligned with the
+original comment character.
+
+@end table
+
+The following variables affect comments:
+
+@vtable @code
+@item maplev-auto-fill-comment-flag
+A boolean flag. If non-nil, the default, comment lines wrap as they are
+typed.  Wrapping, however, does not automatically start in an inline
+comment; it must be invoked with @code{fill-paragraph}.
+
+@item maplev-comment-string
+String variable inserted by @code{indent-for-comment}.
+The default is @samp{# }.
+
+@item maplev-comment-column
+Initial value of @code{comment-column}.  The default is 40.
+
+@item maplev-comment-fill-column
+Initial value of @code{fill-column}.  The default is 79.
+
+@end vtable
+
+Maple comment lines can be continued to the next line by ending them
+with a backslash.  MapleV does @emph{not} recognize this continuation
+and interprets the following line as code.  This can fool the MapleV
+indentation grammar; however, it can also be used to achieve certain
+effects.  @xref{Preventing indentation}, for an example.
+
+
+@node Shortcuts, Imenu support, Comments, top
+@chapter Shortcuts
+@cindex Shortcuts
+
+@menu
+* Abbreviations::               Abbreviations for common Maple functions.
+* Templates::                   Inserting procedures and assignments.
+@end menu
+
+
+@node Abbreviations, Templates, Shortcuts, Shortcuts
+@section Abbreviations
+@cindex Abbreviations
+@cindex Custom abbreviations
+
+Abbreviations are available for common or lengthy Maple keywords. They
+are expanded whenever @code{abbrev-mode} is active.
+@inforef{Abbrevs,,emacs}. The command @code{maplev-abbrev-help} displays
+a list of the available abbreviations.
+
+The following variables affect the expansion of abbreviations:
+
+@table @code
+@item maplev-initial-abbrev-mode-flag
+If non-nil @code{abbrev-mode} is activated when MapleV is started.  The
+default is @samp{t}.
+
+@item maplev-expand-abbrevs-in-comments-and-strings-flag
+If non-nil then the Maple abbreviations are expanded in comments and
+strings. The default is @samp{nil}.
+
+@end table
+
+@menu
+* Customizing Abbreviations::   
+@end menu
+
+
+
+
+@node Customizing Abbreviations,  , Abbreviations, Abbreviations
+@subsection Customizing Abbreviations
+
+The predefined MapleV abbreviations are stored in the abbreviation table
+@code{maplev-mode-abbrev-table}.  The following code may be added to
+your @file{.emacs} file to assign @samp{simp} as an abbreviation for
+@samp{simplify}.
+
+@example
+(define-abbrev maplev-mode-abbrev-table 
+        "simp" "simplify" 'maplev--abbrev-hook)
+@end example
+
+The function @samp{'maplev--abbrev-hook} prevents the abbreviation from
+being expanded inside a comment or quote.
+
+To remove an abbreviation from the table assign it @code{nil}.  For
+example, to prevent @samp{lib} from expanding to @samp{libname}, add the
+following to @file{emacs}:
+
+@example
+(define-abbrev maplev-mode-abbrev-table "lib" nil nil)
+@end example
+
+
+
+
+@node Templates,  , Abbreviations, Shortcuts
+@section Templates
+@cindex Templates
+@cindex Procedure template
+@cindex Template, procedure
+@cindex Assignment operator, template
+
+@kindex C-c C-p
+@kindex C-;
+
+@findex maplev-proc-template
+@findex maplev-insert-assignment-operator
+
+@table @kbd
+@item C-c C-p
+Insert a procedure template (@code{maplev-proc-template}).  The user is
+queried for the name, arguments, and a description of the procedure.
+Any of the entries can be left blank.  If the name is blank then an
+anonymous procedure is inserted, otherwise an assignment is inserted
+with the procedure assigned to the given name.  Backquotes are added
+automatically to procedure names if required by Maple.
+
+@item C-;
+Insert an assignment operator at the end of the current line
+(@code{maplev-insert-assignment-operator}).
+
+@end table
+
+
+The following variables affect the shortcuts:
+
+@vtable @code
+@item maplev-insert-copyright-flag
+If non-nil then a copyright notice is inserted in the @code{option}
+declaration of the procedure template.  The default is @code{t}.
+
+@item maplev-copyright-owner
+String inserted as the copyright owner.
+
+@item maplev-comment-end-flag
+If non-nil then the name of the procedure is inserted as a comment to
+the right of the closing @code{end} statement.
+
+@item maplev-assignment-operator
+The string inserted by @code{maplev-insert-assignment-operator}.
+The default value is @samp{ := }.
+
+@end vtable
+
+
+
+@node Imenu support, Miscellaneous features, Shortcuts, top
+@chapter Imenu support
+@cindex Imenu
+@cindex Index, procedures
+@cindex Procedure index
+
+@findex maplev-add-imenu
+
+Executing @kbd{maplev-add-imenu} or selecting @kbd{MapleV -> Add Index}
+from the menubar creates an indexed menu of the top-level Maple
+procedures, global variables, and macro assignments.  The menu appears
+under the @samp{Index} heading in the menubar.  Clicking on an item in
+the menu moves point to the assignment of that item.
+
+The assignments must be flush left to be indexed.
+Only the first macro in a @code{macro} assignment is indexed.
+
+@node Miscellaneous features, Mint, Imenu support, top
+@comment  node-name,  next,  previous,  up
+@chapter Miscellaneous features
+@cindex Miscellaneous
+
+@menu
+* Include statements::          Active include statements
+@end menu
+
+@node Include statements,  , Miscellaneous features, Miscellaneous features
+@section Include statements
+@cindex Include
+
+@findex maplev-find-include-file-at-point
+Maple include statements, such as @code{$include },
+are font-locked and active.  
+Clicking on them, or typing @kbd{C-c C-o},
+calls @kbd{maplev-find-include-file-at-point},
+which searches for the file and, if successful, opens it.
+If the path exists, but the file does not, the user is
+asked whether to create the file.  
+
+@vindex maplev-include-path
+The include path can be
+assigned, as a list of strings, to the variable @kbd{maplev-include-path}.
+The paths are searched in the order of occurrence in the list.
+
+@vindex maplev-include-file-other-window-flag
+The customizable variable @kbd{maplev-include-file-other-window-flag}
+determines whether the file is opened in the current window or 
+another window.
+
+@node Mint, Maple, Miscellaneous features, top
+@chapter Mint
+@cindex Mint
+@cindex Syntax checking
+@cindex Checking syntax
+
+Mint is Maple's syntax checker. It analyzes a Maple program and produces
+a report about the syntax and variable usage.  MapleV can run mint on
+the entire buffer or a portion of it.  The output of mint is displayed
+in a buffer with a special mode, @code{mint-mode}, that provides a
+convenient means for locating and correcting syntax errors.
+
+@menu
+* Running mint::                Commands for sending code to Mint.
+* Mint mode::                   Mode for viewing the output of Mint.
+@end menu
+
+
+@node Running mint, Mint mode, Mint, Mint
+@section Running mint
+@cindex Running mint
+@cindex Mint, running
+
+@kindex C-c @key{RET} b
+@kindex C-c @key{RET} p
+@kindex C-c @key{RET} r
+@kindex C-c @key{RET} @key{RET}
+
+@findex mint-buffer
+@findex mint-procedure
+@findex mint-region
+@findex mint-rerun
+
+The following commands send source code in the buffer to Mint:
+
+@table @kbd
+@item C-c @key{RET} b
+Run Mint on the buffer (@code{mint-buffer}).
+
+@item C-c @key{RET} p
+Run Mint on the current procedure (@code{mint-procedure}).
+
+@item C-c @key{RET} r
+Run Mint on the marked region (@code{mint-region}).
+
+@item C-c @key{RET} @key{RET}
+Rerun the previous Mint command (@code{mint-rerun}).
+
+@end table
+
+These commands are available through the menubar, @kbd{MapleV -> Mint}.
+The following variables affect the output of Mint:
+
+@vtable @code
+@item mint-info-level
+An integer from 0 to 4 that selects the amount of information displayed
+by Mint.  0 displays no information, 4 displays the most.  The default
+value is 3.  This value can be set through the menubar,
+@kbd{Maplev -> Mint -> Mint level}.
+
+@item mint-start-options
+A string passed to Mint at startup.  The default is @samp{"-q"}, which
+suppresses the display of the Maple logo.  Type @kbd{?mint} in Maple for
+other options.
+
+@item mint-coding-system
+Symbol that defines the coding system used by Mint.  The default value
+is @code{undecided-dos}.
+
+@end vtable
+
+
+@node Mint mode,  , Running mint, Mint
+@section Mint mode
+@cindex Mint mode
+@cindex Mode, Mint
+
+Mint mode is applied to mint's output buffer.  Warnings and errors are
+font locked and activated.  Moving the mouse pointer over active text
+highlights it; clicking it (@kbd{mouse-2}) either moves the cursor to
+the appropriate point in the source code or queries to automatically
+correct an error.
+
+The following commands are available:
+
+@table @kbd
+@item s
+Incremental forward search (@code{isearch-forward}).
+
+@item r
+Incremental backward search (@code{isearch-backward}).
+
+@item @key{RET}
+Re-execute the previous mint command (@code{mint-rerun}).
+
+@item @key{DEL}
+Scroll down (@code{scroll-down}).
+
+@item @key{SPC}
+Scroll up (@code{scroll-up}).
+
+@item mouse-2
+Goto location in source, or fix error, depending on the active text.
+
+@end table
+
+The following variables set the display faces for the highlighted text in the
+Mint buffer:
+
+@vtable @code
+@item mint-proc-face
+Face for procedure names.
+
+@item mint-warning-face
+Face for warnings.
+
+@item mint-error-face
+Face for errors.
+
+@item mint-note-face
+Face for notes (usually @samp{on line}).
+
+@end vtable
+
+
+
+@node Maple, Help pages, Mint, top
+@chapter Maple
+@cindex Cmaple
+@cindex Maple, command line
+
+The command line version of Maple can be started in a buffer.  All or
+portions of the code in the MapleV buffer can be passed directly to the
+Maple process.  Maple commands can be directly executed in the buffer.
+
+@menu
+* Running Maple::               Commands for sending code to the Maple engine.
+* Cmaple mode::                 Mode for interacting with Maple.
+@end menu
+
+
+@node Running Maple, Cmaple mode, Maple, Maple
+@section Running Maple
+@cindex Cmaple, running
+@cindex Running, Cmaple
+
+@kindex C-c C-c b
+@kindex C-c C-c p
+@kindex C-c C-c r
+@kindex C-c C-c g
+@kindex C-c C-c i
+@kindex C-c C-c k
+
+@findex cmaplev-send-buffer
+@findex cmaplev-send-procedure
+@findex cmaplev-send-region
+@findex cmaplev-goto-buffer
+@findex cmaplev-interrupt
+@findex cmaplev-kill
+
+The following commands in the MapleV buffer affect the Maple engine:
+
+@table @kbd
+@itemx C-c C-c b
+Send the entire buffer to the Maple engine (@code{cmaplev-send-buffer}).
+
+@item C-c C-c p
+Send the current procedure to the Maple engine
+(@code{cmaplev-send-procedure}).
+
+@item C-c C-c r
+Send the marked region to the Maple engine (@code{cmaplev-send-region}).
+
+@item C-c C-c g
+Goto the Maple buffer (@code{cmaplev-goto-buffer}).
+
+@item C-c C-c i
+Interrupt the Maple engine (@code{cmaplev-interrupt}).
+
+@item C-c C-c k
+Kill the Maple engine (@code{cmaplev-kill}).
+
+@end table
+
+These commands are available through the menubar, @kbd{MapleV -> Maple}.
+
+
+@node Cmaple mode,  , Running Maple, Maple
+@section Cmaple mode
+@cindex Cmaple mode
+@cindex Mode, cmaple
+
+The command line version of Maple is run in a buffer with the mode
+@code{cmaple-process-mode} that is based on @code{comint-mode}.
+@inforef{Shell Mode,,emacs} for more information.
+In addition to the normal @code{comint} commands, the following commands
+are available:
+
+@table @kbd
+@item ?
+@itemx C-?
+Display a Maple help topic (@pxref{Help pages}).
+
+@item M-?
+Display a Maple procedure (@pxref{Procedures}).
+
+@end table
+
+
+
+@node Help pages, Procedures, Maple, top
+@chapter Help pages
+@cindex Help pages, Maple
+@cindex Maple help pages
+
+Help pages can be read from the Maple help databases and displayed in a
+buffer with major mode @code{maplev-help-mode}.  Text in the buffer is
+highlighted and cross references are activated.
+
+@menu
+* Displaying help pages::       Commands for displaying Maple help pages.
+* MapleV help mode::            Mode for viewing Maple help pages.
+@end menu
+
+
+@node Displaying help pages, MapleV help mode, Help pages, Help pages
+@section Displaying help pages
+
+@kindex C-?
+@kindex S-mouse-2
+
+@findex maplev-help-at-point
+@findex maplev-help-follow-mouse
+
+The following commands display Maple help pages:
+
+@table @kbd
+@item C-?
+Query for a help topic, using the word at point as a default.  Display
+the help page in a buffer (@code{maplev-help-at-point}).
+
+@item S-mouse-2
+Display the Maple help page for the topic at the click
+(@code{maplev-help-follow-mouse}).
+
+@end table
+
+Help pages are displayed in a buffer with major mode
+@code{maplev-help-mode}.
+@ifinfo 
+@xref{MapleV help mode}.
+@end ifinfo
+
+
+@node MapleV help mode,  , Displaying help pages, Help pages
+@section MapleV help mode
+@cindex MapleV help mode
+@cindex Mode, help, MapleV
+@cindex History, help mode
+
+@findex maplev-help-mode
+@findex maplev-clear-history
+
+The major mode @code{maplev-help-mode} is active in the buffer that
+displays Maple help pages.  Section headers are font locked and text in
+the @samp{See Also} section is activated so that clicking on it opens
+the help page for the topic.  The following commands are available:
+
+@kindex s
+@kindex p
+@kindex n
+@kindex P
+@kindex r
+@kindex ?
+
+@table @kbd
+@item s
+Incremental forward search (@code{isearch-forward}).
+
+@item p
+Previous help topic (@code{maplev-prev-item}).
+
+@item n
+Next help topic (@code{maplev-next-item}).
+
+@item P
+Parent help topic (@code{maplev-help-parent}).
+
+@item r
+Redraw help page (@code{maple-redo-item}).
+
+@item ?
+@itemx C-?
+@itemx @key{RTN}
+Query for a help topic (@code{maplev-help-at-point}).
+
+@item M-?
+Query for a procedure (@code{maplev-proc-at-point}).
+
+@item @key{SPC}
+Scroll down.
+
+@item @key{DEL}
+Scroll up.
+
+@end table
+
+MapleV help mode keeps a history of the help topics displayed.
+Use the command @code{maplev-clear-history} to erase the history.
+
+The help page for a chosen topic is displayed by sending the string
+@samp{?TOPIC} to the Maple engine and capturing the output.  If the
+Maple engine is busy an error message, @samp{Maple busy}, is displayed in
+the message window.  
+
+
+
+@node Procedures, Installation, Help pages, top
+@chapter Procedures
+@cindex Procedures, Maple
+@cindex Maple, procedures
+@cindex Displaying Maple procedures
+
+Procedures can be read from the active Maple libraries and displayed in
+a buffer with major mode @code{maplev-proc-mode}. The code is font
+locked the same as in MapleV mode.
+
+@menu
+* Displaying procedures::       Commands to display Maple procedures.
+* MapleV proc mode::            Mode for viewing Maple procedures.
+@end menu
+
+
+@node Displaying procedures, MapleV proc mode, Procedures, Procedures
+@section Displaying procedures
+@kindex M-?
+@kindex M-S-mouse-2
+
+@findex maplev-proc-at-point
+@findex maplev-proc-follow-point
+
+The following commands display Maple procedures:
+
+@table @kbd
+@item M-?
+Query for a procedure name, using the word at point as the default.
+Read the procedure from the Maple library and display it in a buffer
+(@code{maplev-proc-at-point}).
+
+@item M-S-mouse-2
+Read the procedure at the click from the library and display it in a
+buffer (@code{maplev-proc-follow-point}).
+
+@end table
+
+Procedures are displayed in a buffer with major mode
+@code{maplev-proc-mode}.
+@ifinfo
+@xref{MapleV proc mode}.
+@end ifinfo
+
+
+@node MapleV proc mode,  , Displaying procedures, Procedures
+@section MapleV proc mode
+@cindex MapleV proc mode
+@cindex Mode, proc, MapleV
+@cindex History, proc mode
+
+@findex maplev-proc-mode
+The major mode @code{maplev-proc-mode} is active in the buffer that
+displays Maple procedures read from a Maple library.  It font locks the
+procedure, highlighting keywords the same as MapleV mode does.  Clicking
+on procedure names in the buffer displays their source code or opens a
+help page for them.  A history mechanism stores the previously displayed
+procedure.
+
+The following commands are available:
+
+@table @kbd
+@item s
+Incremental forward search (@code{isearch-forward}).
+
+@item p
+Previous procedure (@code{maplev-prev-item}).
+
+@item n
+Next procedure (@code{maplev-next-item}).
+
+@item r
+Redraw procedure (@code{maple-redo-item}).
+
+@item ?
+@itemx C-?
+@itemx @key{RTN}
+Query for a help topic (@code{maplev-help-at-point}).
+
+@item M-?
+Query for a procedure (@code{maplev-proc-at-point}).
+
+@item @key{SPC}
+Scroll down.
+
+@item @key{DEL}
+Scroll up.
+
+@end table
+
+MapleV help mode keeps a history of the help topics displayed.
+Use the command @code{maplev-clear-history} to erase the history.
+
+A procedure is read from a library and displayed by using the Maple
+procedure @samp{maplev_print} that is assigned when the Maple engine is
+started.  If the Maple engine is busy an error message, @samp{Maple
+busy}, is displayed in the message window.
+
+
+
+@c Appendices
+
+
+@node Installation, Evolution, Procedures, top
+@appendix Installation
+
+@cindex Installation
+@cindex @file{.emacs}
+@cindex Initialization
+@cindex Customization
+
+This section describes how to install MapleV into GNU Emacs.
+
+@menu
+* Compiling::                   Byte compiling MapleV.
+* Customizing::                 Customizing the installation.
+* Info documentation::          Installing the Info documentation.
+@end menu
+
+
+
+@node Compiling, Customizing, Installation, Installation
+@section Compiling
+
+Move the file @file{maplev.el} into your Emacs load path and byte
+compile it as shown below:
+
+@example
+@kbd{M-x byte-compile-file} @key{RET} maplev.el @key{RET}
+@end example
+
+Add the following line to your @file{.emacs} file:
+
+@example
+(autoload 'maplev-mode "maplev" "Maple editing mode" t)
+@end example
+
+To have Emacs auto-magically start in MapleV mode when editing Maple
+source, add the following to your @file{.emacs} file, modifying the
+regex @file{.mpl} to an extension appropriate for your usage:
+
+@example
+(setq auto-mode-alist 
+      (cons `("\\.mpl\\'" . maplev-mode) auto-mode-alist))
+@end example
+
+
+@node Customizing, Info documentation, Compiling, Installation
+@section Customizing
+
+You must customize some of MapleV's default settings to be appropriate
+for your installation.  Most significantly, you must specify the
+locations of the executable files for mint and the command line version
+of Maple.  You can specify multiple versions of mint and Maple.  The
+easiest method is to invoke @code{customize} using the following
+commands:
+
+@example
+M-x load-library @key{RET} maplev @key{RET}
+M-x customize-group @key{RET} maplev @key{RET}
+@end example
+
+The important options are in the subgroup @code{maplev-important}.
+After setting these options, save them to your @file{.emacs} file by
+clicking on the @samp{Save for Future Sessions} button.
+
+
+@node Info documentation,  , Customizing, Installation
+@section Info documentation
+
+To create the Info documentation for MapleV, convert the TeXinfo
+file @file{maplev.texi} to an Info file.  You may use either the
+stand-alone utility @code{makeinfo} or, from inside Emacs, the command
+@code{makeinfo-buffer}.
+
+Move the output file @file{maplev} to a directory in the Info
+load path and then edit the @file{dir} file, that is,
+the top level node of your Emacs Info structure, to point to 
+@file{maplev}.  I added the following menu item to my @file{dir} file:
+
+@example
+* MapleV: (maplev).       MapleV reference manual.
+@end example
+
+
+
+
+@node Evolution, Key Index, Installation, top
+@appendix Evolution
+
+
+@menu
+* Bugs::                        
+* Acknowledgments::             
+* Enhancements::                
+@end menu
+
+@node Bugs, Acknowledgments, Evolution, Evolution
+@section Bugs
+
+If you encounter a bug in this package, wish to suggest an enhancement,
+or want to make a smart remark, then send an email to me, the humble
+developer.
+
+   Joseph S. Riel (Joe Riel) @samp{joer@@k-online.com}
+
+
+@node Acknowledgments, Enhancements, Bugs, Evolution
+@section Acknowledgements
+@cindex Acknowledgements
+@cindex Credits
+@cindex Gap mode
+
+I'd like to thank a number of people who have contributed, either
+directly or indirectly, to this package.
+
+
+@table @b
+@item Bruno Salvy
+For writing @code{maple-mode}, a small but useful Emacs
+mode for editing Maple code.
+
+@item Michael Smith
+For writing @code{Gap-mode} and @code{Gap-process}.
+These gave me the idea, and showed me how, to display help pages.
+Displaying source code from the Maple libraries was a natural extension.
+@code{Gap} is a CAS specialized for group theory.
+
+@item Nicholas Thi@'ery
+For writing @code{Maple-mode}, another Emacs mode for
+editing Maple code.  It introduced the idea of using a grammar to indent
+Maple source code.
+
+@item Bob Glickstein
+For writing @cite{Writing GNU Emacs Extensions}.
+It allowed me, a novice Elisp programmer, to put it all together.
+
+@item Christian Pomar
+For courageously agreeing to test a series of alpha
+versions of this package.  He found numerous errors and suggested many
+improvements.
+
+@end table
+
+
+@node Enhancements,  , Acknowledgments, Evolution
+@section Enhancements
+@cindex Enhancements
+@cindex Debugger, source code
+@cindex Code debugger
+@cindex LaTeX 
+@cindex MapleDoc
+
+The following is a short list of features that I am tentatively planning
+to add to MapleV.
+
+@itemize @bullet
+@item
+Source code debugger.  The Maple debugger @code{DEBUG} provides a useful
+means to step through code; its interface, however, leaves much to be
+desired.  A more convenient interface would be similar to that of
+@code{Edebug}, the Emacs-Lisp source code debugger.
+
+@item
+La@TeX{} support.  I use MapleDoc, a La@TeX{} macro package that I wrote,
+for documenting Maple source code.  To facilitate its use MapleV should
+be able to font-lock La@TeX{} keywords in comments.  This will be an
+optional package.
+
+@end itemize
+
+
+
+
+@node Key Index, Function Index, Evolution, top
+@comment    node-name,         next,       previous, up
+@unnumbered Key Index
+
+@printindex ky
+
+@node Function Index, Variable Index, Key Index, top
+@comment    node-name,         next,       previous, up
+@unnumbered Function Index
+
+@printindex fn
+
+@node Variable Index,  , Function Index, top
+@comment    node-name,         next,       previous, up
+@unnumbered Variable Index
+
+@printindex vr
+
+@printindex cp
+
+@summarycontents
+@contents
+@bye
+
diff --git a/elisp/emacs-goodies-el/marker-visit.el b/elisp/emacs-goodies-el/marker-visit.el
new file mode 100755
index 0000000..d12f876
--- /dev/null
+++ b/elisp/emacs-goodies-el/marker-visit.el
@@ -0,0 +1,131 @@
+;;; marker-visit.el --- navigate through a buffer's marks in order
+
+;; Copyright (C) 2001 Benjamin Rutt
+;;
+;; Maintainer: Benjamin Rutt 
+;; Version: 1.1
+
+;; 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 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 GNU Emacs; see the file COPYING.  If not, send e-mail to
+;; this program's maintainer or write to the Free Software Foundation,
+;; Inc., 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This file provides a simple way to navigate among marks in a
+;; buffer.  C-u C-SPC is similar, but takes you haphazardly around the
+;; buffer.  Setting bookmarks is a lot of extra work if you just want
+;; to jump around your buffer quickly; plus, you have to come up with
+;; a name for every bookmark.
+
+;; All the marks you've left while editing a buffer serve as bread
+;; crumb trails of areas in the buffer you've edited.  It is
+;; convenient to navigate back and forth among these marks in order.
+;; This file provides two methods to do just that, marker-visit-prev
+;; and marker-visit-next.  These two functions will take you, from
+;; point, to the nearest mark in either direction.  The function
+;; marker-visit-truncate-mark-ring will truncate the mark ring.
+
+;; The marks you can visit in a buffer consist of: "the mark" plus the
+;; contents of the mark-ring.
+
+;;; Usage:
+
+;; put this file in your load-path and add the line
+;;
+;; (require 'marker-visit)
+;;
+;; to your ~/.emacs file.
+;;
+;; This package is most useful when some easy-to-press keys are bound
+;; to the functions marker-visit-prev and marker-visit-next.  See C-h
+;; i m Emacs RET m Key Bindings RET for info on emacs key bindings.
+
+;;; History:
+
+;; 1.0 -> 1.1 Incorporated patch from Colin Walters to make the code
+;; consistent with elisp code conventions mentioned in 
+;; (Info-goto-node "(elisp) Coding Conventions").
+
+;;; Code:
+
+;;utility remove-dupes function
+(defun marker-visit-remove-dupes (ls)
+  (cond
+   ((null ls) '())
+   ((member (car ls) (cdr ls)) (marker-visit-remove-dupes (cdr ls)))
+   (t (cons (car ls) (marker-visit-remove-dupes (cdr ls))))))
+
+;;create a sorted list of marks, including the point as mark, the
+;;mark, and the contents of the mark-ring.
+(defun marker-visit-get-sorted-mark-set (current-point-mark)
+  (marker-visit-remove-dupes
+   (sort
+    (append (cons current-point-mark
+		  (if (mark-marker) (list (mark-marker)) nil))
+	    (mapcar (lambda (id) id) mark-ring))
+    (lambda (a b) (< a b)))))
+
+(defun marker-visit-no-markers-p ()
+  (and (null mark-ring)
+       (or (not (mark-marker))
+	   (not (marker-position (mark-marker))))))
+
+(defun marker-visit-warn (error-message)
+  (message error-message)
+  (beep))
+
+(defun marker-visit-prev ()
+  "From point, visit the nearest mark earlier in the buffer."
+  (interactive)
+  (if (marker-visit-no-markers-p)
+      (marker-visit-warn "Mark does not point anywhere")
+    (let* ((current-point-mark (point-marker))
+	   (sorted-marks (marker-visit-get-sorted-mark-set current-point-mark))
+	   (dest-mark nil))
+      (while (not (equal current-point-mark (car sorted-marks)))
+	(setq dest-mark (car sorted-marks))
+	(setq sorted-marks (cdr sorted-marks)))
+      (if dest-mark
+	  (goto-char dest-mark)
+	(marker-visit-warn "No previous mark to visit")))))
+
+(defun marker-visit-next ()
+  "From point, visit the nearest mark later in the buffer."
+  (interactive)
+  (if (marker-visit-no-markers-p)
+      (marker-visit-warn "Mark does not point anywhere")
+    (let* ((current-point-mark (point-marker))
+	   (sorted-marks (marker-visit-get-sorted-mark-set current-point-mark))
+	   (dest-mark nil)
+	   (done nil))
+      (while (not done)
+	(if (equal current-point-mark (car sorted-marks))
+	    (progn
+	      (setq dest-mark (cadr sorted-marks))
+	      (setq done t))
+	  (setq sorted-marks (cdr sorted-marks))))
+      (if dest-mark
+	  (goto-char dest-mark)
+	(marker-visit-warn "No next mark to visit")))))
+
+(defun marker-visit-truncate-mark-ring ()
+  "Truncate the `mark-ring'."
+  (interactive)
+  (setq mark-ring nil))
+
+(provide 'marker-visit)
+
+;; marker-visit.el ends here
diff --git a/elisp/emacs-goodies-el/matlab.el b/elisp/emacs-goodies-el/matlab.el
new file mode 100644
index 0000000..f6852cf
--- /dev/null
+++ b/elisp/emacs-goodies-el/matlab.el
@@ -0,0 +1,5814 @@
+;;; matlab.el --- major mode for MATLAB(R) dot-m files
+;;
+;; Author: Matt Wette ,
+;;         Eric M. Ludlam 
+;; Maintainer: Eric M. Ludlam 
+;; Created: 04 Jan 91
+;; Keywords: MATLAB(R)
+;; Version:
+
+(defconst matlab-mode-version "3.3.2"
+  "Current version of MATLAB(R) mode.")
+
+;;
+;; Copyright (C) 2004-2010 The Mathworks, Inc
+;; Copyright (C) 1997-2004 Eric M. Ludlam: The MathWorks, Inc
+;; Copyright (C) 1991-1997 Matthew R. Wette
+;;
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;;
+;;; Commentary:
+;;
+;; This major mode for GNU Emacs provides support for editing MATLAB(R) dot-m
+;; files.  It automatically indents for block structures (including nested
+;; functions), line continuations (e.g., ...), and comments.
+;;
+;; Additional features include auto-fill including auto-additions of
+;; ellipsis for commands, and even strings.  Block/end construct
+;; highlighting as you edit.  Primitive code-verification and
+;; identification.  Templates and other code editing functions.
+;; Advanced symbol completion.  Code highlighting via font-lock.
+;; There are many navigation commands that let you move across blocks
+;; of code at different levels.
+;;
+;; Lastly, there is support for running MATLAB(R) in an Emacs buffer,
+;; with full shell history and debugger support (when used with the db
+;; commands.)  The shell can be used as an online help while editing
+;; code, providing help on functions, variables, or running arbitrary
+;; blocks of code from the buffer you are editing.
+
+;;; Code:
+
+(require 'easymenu)
+(require 'tempo)
+(require 'derived)
+
+;; compatibility
+(if (string-match "X[Ee]macs" emacs-version)
+    (progn
+      (defalias 'matlab-make-overlay 'make-extent)
+      (defalias 'matlab-overlay-put 'set-extent-property)
+      (defalias 'matlab-overlay-get 'extent-property)
+      (defalias 'matlab-delete-overlay 'delete-extent)
+      (defalias 'matlab-overlay-start 'extent-start-position)
+      (defalias 'matlab-overlay-end 'extent-end-position)
+      (defalias 'matlab-previous-overlay-change 'previous-extent-change)
+      (defalias 'matlab-next-overlay-change 'next-extent-change)
+      (defalias 'matlab-overlays-at
+	(lambda (pos) (extent-list nil pos pos)))
+      (defalias 'matlab-cancel-timer 'delete-itimer)
+      (defun matlab-run-with-idle-timer (secs repeat function &rest args)
+	(condition-case nil
+	    (apply 'start-itimer
+		   "matlab" function secs
+		   (if repeat secs nil) t
+		   t (car args))
+	  (error
+	   ;; If the above doesn't work, then try this old version of
+	   ;; start itimer.
+	   (start-itimer "matlab" function secs (if repeat secs nil)))))
+      )
+  (defalias 'matlab-make-overlay 'make-overlay)
+  (defalias 'matlab-overlay-put 'overlay-put)
+  (defalias 'matlab-overlay-get 'overlay-get)
+  (defalias 'matlab-delete-overlay 'delete-overlay)
+  (defalias 'matlab-overlay-start 'overlay-start)
+  (defalias 'matlab-overlay-end 'overlay-end)
+  (defalias 'matlab-previous-overlay-change 'previous-overlay-change)
+  (defalias 'matlab-next-overlay-change 'next-overlay-change)
+  (defalias 'matlab-overlays-at 'overlays-at)
+  (defalias 'matlab-cancel-timer 'cancel-timer)
+  (defalias 'matlab-run-with-idle-timer 'run-with-idle-timer)
+  )
+
+(cond ((fboundp 'point-at-bol)
+       (defalias 'matlab-point-at-bol 'point-at-bol)
+       (defalias 'matlab-point-at-eol 'point-at-eol))
+      ;; Emacs 20.4
+      ((fboundp 'line-beginning-position)
+       (defalias 'matlab-point-at-bol 'line-beginning-position)
+       (defalias 'matlab-point-at-eol 'line-end-position))
+      (t
+       (defmacro matlab-point-at-bol ()
+	 (save-excursion (beginning-of-line) (point)))
+       (defmacro matlab-point-at-eol ()
+	 (save-excursion (end-of-line) (point)))))
+
+(defmacro matlab-run-in-matlab-mode-only (&rest body)
+  "Execute BODY only if the active buffer is a MATLAB(R) M-file buffer."
+  `(if (eq major-mode 'matlab-mode)
+       (progn
+	,@body)
+     (error "This command works only in a MATLAB M-file buffer")))
+
+(defun matlab-with-emacs-link ()
+  "Return non-nil if Emacs Link is running and user wants to use it."
+  (and (featurep 'matlab-eei)
+       matlab-use-eei
+       matlab-eei-process))
+
+;;; User-changeable variables =================================================
+
+;; Variables which the user can change
+(defgroup matlab nil
+  "MATLAB(R) mode."
+  :prefix "matlab-"
+  :group 'languages)
+
+(defcustom matlab-indent-level 4
+  "*The basic indentation amount in `matlab-mode'."
+  :group 'matlab
+  :type 'integer)
+
+(defcustom matlab-cont-level 4
+  "*Basic indentation after continuation if no other methods are found."
+  :group 'matlab
+  :type 'integer)
+
+(defcustom matlab-cont-requires-ellipsis t
+  "*Specify if ellipses are required at the end of a line for continuation.
+Future versions of Matlab may not require ellipses ... , so a heuristic
+determining if there is to be continuation is used instead."
+  :group 'matlab
+  :type 'integer)
+
+(defcustom matlab-case-level '(2 . 2)
+  "*How far to indent case/otherwise statements in a switch.
+This can be an integer, which is the distance to indent the CASE and
+OTHERWISE commands, and how far to indent commands appearing in CASE
+and OTHERWISE blocks.  It can also be a cons cell which is of form
+  (CASEINDENT . COMMANDINDENT)
+where CASEINDENT is the indentation of the CASE and OTHERWISE
+statements, and COMMANDINDENT is the indentation of commands appearing
+after the CASE or OTHERWISE command.
+
+Note: Currently a bug exists if:
+  CASEINDENT+COMMANDINDENT != `matlab-indent-level'
+so if you customize these variables, follow the above rule, and you
+should be ok."
+  :group 'matlab
+  :type 'sexp)
+
+(defcustom matlab-indent-function-body 'guess
+  "*If non-nil, indent body of function.
+If the global value is nil, do not indent function bodies.
+If the global value is t, always indent function bodies.
+If the global value is 'guess, then the local value will be set to
+either nil or t when the MATLAB mode is started in a buffer based on the
+file's current indentation.
+If the global value is 'MathWorks-Standard, then the local value is not
+changed, and functions are indented based on `matlab-functions-have-end'."
+  :group 'matlab
+  :type '(choice (const :tag "Always" t)
+		 (const :tag "Never" nil)
+		 (const :tag "Guess" 'guess)
+                 (const :tag "MathWorks Standard"
+                        'MathWorks-Standard))
+  )
+
+(make-variable-buffer-local 'matlab-indent-function-body)
+
+(defcustom matlab-functions-have-end nil
+  "*If non-nil, functions-have-end minor mode is on by default."
+  :group 'matlab
+  :type 'boolean)
+
+(make-variable-buffer-local 'matlab-functions-have-end)
+
+(defun matlab-toggle-functions-have-end ()
+  (interactive)
+  (matlab-toggle-functions-have-end-minor-mode))
+
+;; The following minor mode is on if and only if the above variable is true;
+(easy-mmode-define-minor-mode matlab-functions-have-end-minor-mode
+  "Toggle functions-have-end minor mode, indicating function/end pairing."
+  nil
+  (condition-case nil ;; avoid parse error on xemacs
+      (eval (read "#(\" function...end\" 0 15 (face (font-lock-keyword-face) fontified t))"))
+    (error " function...end"))
+  nil ; empty mode-map
+  ;; body of matlab-functions-have-end-minor-mode
+  (if matlab-functions-have-end-minor-mode
+      (setq matlab-functions-have-end t)
+    (setq matlab-functions-have-end nil)
+    )
+)
+
+(defun matlab-do-functions-have-end-p ()
+  "Non-nil if the first function in the current buffer terminates with end."
+  (save-excursion
+    (goto-char (point-min))
+    (if (re-search-forward matlab-defun-regex nil t)
+        (let ((matlab-functions-have-end t))
+          (beginning-of-line)
+          (condition-case nil
+              (progn (matlab-forward-sexp) t)
+            (error nil))
+          )
+      nil
+      )
+    ))
+
+(defun matlab-toggle-functions-have-end-minor-mode ()
+  (matlab-functions-have-end-minor-mode)
+  (if (and matlab-functions-have-end-minor-mode (not (eq major-mode 'matlab-mode)))
+      (progn
+	(matlab-functions-have-end-minor-mode -1)
+	(error "functions-have-end minor mode is only for MATLAB Major mode")))
+  (setq matlab-functions-have-end matlab-functions-have-end-minor-mode))
+
+(defun matlab-indent-function-body-p ()
+  "Non-nil if functions bodies are indented. 
+See `matlab-indent-function-body' variable."
+  (if (eq matlab-indent-function-body 'MathWorks-Standard)
+      ;; Dec '09
+      ;; The MathWorks standard is the same as if functions have end.
+      matlab-functions-have-end
+    ;; Else, just return the variable.
+    matlab-indent-function-body))
+
+(defcustom matlab-indent-past-arg1-functions
+  "[sg]et\\(_param\\)?\\|waitfor"
+  "*Regex describing functions whose first arg is special.
+This specialness means that all following parameters which appear on
+continued lines should appear indented to line up with the second
+argument, not the first argument."
+  :group 'matlab
+  :type 'string)
+
+(defcustom matlab-arg1-max-indent-length 15
+  "*The maximum length to indent when indenting past arg1.
+If arg1 is exceptionally long, then only this number of characters
+will be indented beyond the open paren starting the parameter list.")
+
+(defcustom matlab-maximum-indents '(;; = is a convenience. Don't go too far
+				    (?= . (10 . 4))
+				    ;; Fns should provide hard limits
+				    (?\( . 50)
+				    ;; Matrix/Cell arrays
+				    (?\[ . 20)
+				    (?\{ . 20))
+  "Alist of maximum indentations when lining up code.
+Each element is of the form (CHAR . INDENT) where char is a character
+the indent engine is using, and INDENT is the maximum indentation
+allowed.  Indent could be of the form (MAXIMUM . INDENT), where
+MAXIMUM is the maximum allowed calculated indent, and INDENT is the
+amount to use if MAXIMUM is reached."
+  :group 'matlab
+  :type '(repeat (cons (character :tag "Open List Character")
+		       (sexp :tag "Number (max) or cons (max indent)"))))
+
+(defcustom matlab-handle-simulink t
+  "*If true, add in a few simulink customizations.
+This variable's state is mostly useful when set at load time when
+simulink font lock keywords can be removed.  This will handle
+additional cases as the need arrises."
+  :group 'matlab
+  :type 'boolean)
+
+(defcustom matlab-auto-fill t
+  "*If true, set variable `auto-fill-function' to our function at startup."
+  :group 'matlab
+  :type 'boolean)
+
+(defcustom matlab-fill-fudge 10
+  "Number of characters around `fill-column' we can fudge filling.
+Basically, there are places that are very convenient to fill at, but
+might not be the closest fill spot, or occur after `fill-column'.
+If they occur within this fudge factor, we will use them.
+Also, if none of the above occur, and we find a symbol to break at,
+but an open paren (group) starts or ends within this fudge factor,
+move there to boost the amount of fill leverage we can get."
+  :group 'matlab
+  :type 'integer)
+
+(defcustom matlab-fill-fudge-hard-maximum 79
+  "The longest line allowed when auto-filling code.
+This overcomes situations where the `fill-column' plus the
+`matlab-fill-fudge' is greater than some hard desired limit."
+  :group 'matlab
+  :type 'integer)
+
+(defcustom matlab-elipsis-string "..."
+  "Text used to perform continuation on code lines.
+This is used to generate and identify continuation lines.")
+
+(defcustom matlab-fill-code t
+  "*If true, `auto-fill-mode' causes code lines to be automatically continued."
+  :group 'matlab
+  :type 'boolean)
+
+(defcustom matlab-fill-count-ellipsis-flag t
+  "*Non-nil means to count the ellipsis when auto filling.
+This effectively shortens the `fill-column' by the length of
+`matlab-elipsis-string'.")
+
+(defcustom matlab-fill-strings-flag t
+  "*Non-nil means that when auto-fill is on, strings are broken across lines.
+If `matlab-fill-count-ellipsis-flag' is non nil, this shortens the
+`fill-column' by the length of `matlab-elipsis-string'.")
+
+(defcustom matlab-comment-column 40
+  "*The goal comment column in `matlab-mode' buffers."
+  :group 'matlab
+  :type 'integer)
+
+(defcustom matlab-comment-anti-indent 0
+  "*Amount of anti-indentation to use for comments in relation to code."
+  :group 'matlab
+  :type 'integer)
+
+(defcustom matlab-comment-line-s "% "
+  "*String to start comment on line by itself."
+  :group 'matlab
+  :type 'string)
+
+(defcustom matlab-comment-on-line-s "% "
+  "*String to start comment on line with code."
+  :group 'matlab
+  :type 'string)
+
+(defcustom matlab-comment-region-s "% $$$ "
+  "*String inserted by \\[matlab-comment-region] at start of each line in \
+region."
+  :group 'matlab
+  :type 'string)
+
+(defcustom matlab-verify-on-save-flag t
+  "*Non-nil means to verify M whenever we save a file."
+  :group 'matlab
+  :type 'boolean)
+
+(defcustom matlab-mode-verify-fix-functions
+  '(matlab-mode-vf-functionname)
+  "List of function symbols which perform a verification and fix to M code.
+Each function gets no arguments, and returns nothing.  They can move
+point, but it will be restored for them."
+  :group 'matlab
+  :type '(repeat (choice :tag "Function: "
+			 '(matlab-mode-vf-functionname
+			   matlab-mode-vf-block-matches-forward
+			   matlab-mode-vf-block-matches-backward
+			   matlab-mode-vf-quiesce-buffer
+			   ))))
+
+(defcustom matlab-block-verify-max-buffer-size 50000
+  "*Largest buffer size allowed for block verification during save."
+  :group 'matlab
+  :type 'integer)
+
+;; It is time to disable this.
+(defcustom matlab-vers-on-startup nil
+  "*If non-nil, show the version number on startup."
+  :group 'matlab
+  :type 'boolean)
+
+(defcustom matlab-highlight-block-match-flag t
+  "*Non-nil means to highlight the matching if/end/whatever.
+The highlighting only occurs when the cursor is on a block start or end
+keyword."
+  :group 'matlab
+  :type 'boolean)
+
+(defcustom matlab-show-periodic-code-details-flag nil
+  "*Non-nil means to show code details in the minibuffer.
+This will only work if `matlab-highlight-block-match-flag' is non-nil."
+  :group 'matlab
+  :type 'boolean)
+
+(defcustom matlab-use-eei t
+  "*Use Emacs Link for save-and-go and run-region."
+  :group 'matlab
+  :type 'boolean)
+
+(defcustom matlab-mode-hook nil
+  "*List of functions to call on entry to MATLAB mode."
+  :group 'matlab
+  :type 'hook)
+
+(defcustom matlab-completion-technique 'complete
+  "*How the `matlab-complete-symbol' interfaces with the user.
+Valid values are:
+
+'increment - which means that new strings are tried with each
+             successive call until all methods are exhausted.
+             (Similar to `hippie-expand'.)
+'complete  - Which means that if there is no single completion, then
+             all possibilities are displayed in a completion buffer."
+  :group 'matlab
+  :type '(radio (const :tag "Incremental completion (hippie-expand)."
+		       increment)
+		(const :tag "Show completion buffer."
+		       complete)))
+
+(defcustom matlab-show-mlint-warnings nil
+  "*If non-nil, show mlint warnings."
+  :group 'matlab
+  :type 'boolean)
+
+(make-variable-buffer-local 'matlab-show-mlint-warnings)
+
+(defcustom matlab-highlight-cross-function-variables nil
+  "*If non-nil, highlight cross-function variables."
+  :group 'matlab
+  :type 'boolean)
+
+(make-variable-buffer-local 'matlab-highlight-cross-function-variables)
+
+(defcustom matlab-return-add-semicolon nil
+  "*If non nil, check to see a semicolon is needed when RET is pressed."
+  :group 'matlab
+  :type 'boolean)
+
+(make-variable-buffer-local 'matlab-return-add-semicolon)
+
+;; Load in the region we use for highlighting stuff.
+(if (and (featurep 'custom) (fboundp 'custom-declare-variable))
+
+    (let ((l-region-face (if (facep 'region) 'region 'zmacs-region)))
+      ;; If we have custom, we can make our own special face like this
+      (defface matlab-region-face
+	(list
+	 (list t
+	       (list :background (face-background l-region-face)
+		     :foreground (face-foreground l-region-face))))
+	"*Face used to highlight a matlab region."
+	:group 'matlab))
+
+  ;; If we do not, then we can fake it by copying 'region.
+  (cond ((facep 'region)
+	 (copy-face 'region 'matlab-region-face))
+	(t
+	 (copy-face 'zmacs-region 'matlab-region-face))))
+
+(defvar matlab-unterminated-string-face 'matlab-unterminated-string-face
+  "Self reference for unterminated string face.")
+
+(defvar matlab-simulink-keyword-face 'matlab-simulink-keyword-face
+  "Self reference for simulink keywords.")
+
+(defvar matlab-nested-function-keyword-face 'matlab-nested-function-keyword-face
+  "Self reference for nested function/end keywords.")
+
+(defvar matlab-cross-function-variable-face 'matlab-cross-function-variable-face
+  "Self reference for cross-function variables.")
+
+(defvar matlab-cellbreak-face 'matlab-cellbreak-face
+  "Self reference for cellbreaks.")
+
+(defun matlab-font-lock-adjustments ()
+  "Make adjustments for font lock.
+If font lock is not loaded, lay in wait."
+  (if (and (featurep 'custom) (fboundp 'custom-declare-variable))
+	
+      (progn
+	(defface matlab-unterminated-string-face
+	  (list
+	   (list t
+		 (list :background (face-background font-lock-string-face)
+		       :foreground (face-foreground font-lock-string-face)
+		       :underline t)))
+	  "*Face used to highlight unterminated strings."
+	  :group 'matlab)
+	(defface matlab-simulink-keyword-face
+	  (list
+	   (list t
+		 (list :background (face-background font-lock-type-face)
+		       :foreground (face-foreground font-lock-type-face)
+		       :underline t)))
+	  "*Face used to highlight simulink specific functions."
+	  :group 'matlab)
+        (defface matlab-nested-function-keyword-face
+	  (list
+	   (list t
+		 (list :slant  'italic)))
+          "*Face to use for cross-function variables.")
+        (defface matlab-cross-function-variable-face
+	  (list
+	   (list t
+		 (list :weight 'bold
+                       :slant  'italic)))
+          "*Face to use for cross-function variables."
+	  :group 'matlab)
+	(defface matlab-cellbreak-face
+	  (list
+	   (list t
+		 (list :background (face-background font-lock-comment-face)
+		       :foreground (face-foreground font-lock-comment-face)
+		       :overline t
+		       :bold t)))
+	  "*Face to use for cellbreak %% lines.")
+	)
+      
+    ;; Now, lets make the unterminated string face
+    (cond ((facep 'font-lock-string-face)
+	   (copy-face 'font-lock-string-face
+		      'matlab-unterminated-string-face))
+	  (t
+	   (make-face 'matlab-unterminated-string-face)))
+    (set-face-underline-p 'matlab-unterminated-string-face t)
+    
+    ;; Now make some simulink faces
+    (cond ((facep 'font-lock-type-face)
+	   (copy-face 'font-lock-type-face 'matlab-simulink-keyword-face))
+	  (t
+	   (make-face 'matlab-simulink-keyword-face)))
+    (set-face-underline-p 'matlab-simulink-keyword-face t)
+    
+    ;; Now make some nested function/end keyword faces
+    (cond ((facep 'font-lock-type-face)
+	   (copy-face 'font-lock-type-face 'matlab-nested-function-keyword-face))
+	  (t
+	   (make-face 'matlab-nested-function-keyword-face)))
+    
+    ;; Now make some cross-function variable faces
+    (cond ((facep 'font-lock-type-face)
+	   (copy-face 'font-lock-type-face 'matlab-cross-function-variable-face))
+	  (t
+	   (make-face 'matlab-cross-function-variable-face)))
+    (set-face-bold-p 'matlab-cross-function-variable-face t)
+
+    ;; Now make some cellbreak variable faces
+    (cond ((facep 'font-comment-face)
+	   (copy-face 'font-lock-comment-face 'matlab-cellbreak-face))
+	  (t
+	   (make-face 'matlab-cellbreak-face)))
+    (set-face-bold-p 'matlab-cellbreak-face t)
+    (condition-case nil
+	(set-face-attribute 'matlab-cellbreak-face nil :overline t)
+      (error nil))
+    )
+  (remove-hook 'font-lock-mode-hook 'matlab-font-lock-adjustments))
+
+;; Make the adjustments for font lock after it's loaded.
+;; I found that eval-after-load was unreliable.
+(if (featurep 'font-lock)
+    (matlab-font-lock-adjustments)
+  (add-hook 'font-lock-mode-hook 'matlab-font-lock-adjustments))
+
+
+;;; MATLAB mode variables =====================================================
+
+(defvar matlab-tempo-tags nil
+  "List of templates used in MATLAB mode.")
+
+;; syntax table
+(defvar matlab-mode-syntax-table
+  (let ((st (make-syntax-table (standard-syntax-table))))
+    (modify-syntax-entry ?_  "_" st)
+    (modify-syntax-entry ?%  "<" st)
+    (modify-syntax-entry ?\n ">" st)
+    (modify-syntax-entry ?\\ "." st)
+    (modify-syntax-entry ?\t " " st)
+    (modify-syntax-entry ?+  "." st)
+    (modify-syntax-entry ?-  "." st)
+    (modify-syntax-entry ?*  "." st)
+    (modify-syntax-entry ?'  "." st)
+    (modify-syntax-entry ?/  "." st)
+    (modify-syntax-entry ?=  "." st)
+    (modify-syntax-entry ?<  "." st)
+    (modify-syntax-entry ?>  "." st)
+    (modify-syntax-entry ?&  "." st)
+    (modify-syntax-entry ?|  "." st)
+    st)
+  "The syntax table used in `matlab-mode' buffers.")
+
+(defvar matlab-mode-special-syntax-table
+  (let ((st (copy-syntax-table matlab-mode-syntax-table)))
+    ;; Make _ a part of words so we can skip them better
+    (modify-syntax-entry ?_  "w" st)
+    st)
+  "The syntax table used when navigating blocks.")
+
+;; abbrev table
+(defvar matlab-mode-abbrev-table nil
+  "The abbrev table used in `matlab-mode' buffers.")
+
+(define-abbrev-table 'matlab-mode-abbrev-table ())
+
+;;; Keybindings ===============================================================
+
+(defvar matlab-help-map
+  (let ((km (make-sparse-keymap)))
+    (define-key km "r" 'matlab-shell-run-command)
+    (define-key km "f" 'matlab-shell-describe-command)
+    (define-key km "a" 'matlab-shell-apropos)
+    (define-key km "v" 'matlab-shell-describe-variable)
+    (define-key km "t" 'matlab-shell-topic-browser)
+    km)
+  "The help key map for `matlab-mode' and `matlab-shell-mode'.")
+
+(defvar matlab-insert-map
+  (let ((km (make-sparse-keymap)))
+    (define-key km "c" 'matlab-insert-next-case)
+    (define-key km "e" 'matlab-insert-end-block)
+    (define-key km "i" 'tempo-template-matlab-if)
+    (define-key km "I" 'tempo-template-matlab-if-else)
+    (define-key km "f" 'tempo-template-matlab-for)
+    (define-key km "s" 'tempo-template-matlab-switch)
+    (define-key km "t" 'tempo-template-matlab-try)
+    (define-key km "w" 'tempo-template-matlab-while)
+    (define-key km "F" 'tempo-template-matlab-function)
+    (define-key km "'" 'matlab-stringify-region)
+    ;; Not really inserts, but auto coding stuff
+    (define-key km "\C-s" 'matlab-ispell-strings)
+    (define-key km "\C-c" 'matlab-ispell-comments)
+    km)
+  "Keymap used for inserting simple texts based on context.")
+
+;; mode map
+(defvar matlab-mode-map
+  (let ((km (make-sparse-keymap)))
+    (define-key km [return] 'matlab-return)
+    (define-key km "%" 'matlab-electric-comment)
+    (define-key km "\C-c;" 'matlab-comment-region)
+    (define-key km "\C-c:" 'matlab-uncomment-region)
+    (define-key km [(control c) return] 'matlab-comment-return)
+    (define-key km [(control c) (control c)] matlab-insert-map)
+    (define-key km [(control c) (control f)] 'matlab-fill-comment-line)
+    (define-key km [(control c) (control j)] 'matlab-justify-line)
+    (define-key km [(control c) (control q)] 'matlab-fill-region)
+    (define-key km [(control c) (control s)] 'matlab-shell-save-and-go)
+    (define-key km [(control c) (control r)] 'matlab-shell-run-region)
+    (define-key km [(meta control return)] 'matlab-shell-run-cell)
+    (define-key km [(control c) (control t)] 'matlab-show-line-info)
+    (define-key km [(control c) ?. ] 'matlab-find-file-on-path)
+    (define-key km [(control h) (control m)] matlab-help-map)
+    (define-key km [(control j)] 'matlab-linefeed)
+    (define-key km "\M-\r" 'newline)
+    (define-key km [(meta \;)] 'matlab-comment)
+    (define-key km [(meta q)] 'matlab-fill-paragraph)
+    (define-key km [(meta a)] 'matlab-beginning-of-command)
+    (define-key km [(meta e)] 'matlab-end-of-command)
+    (define-key km [(meta j)] 'matlab-comment-line-break-function)
+    (define-key km [(meta s)] 'matlab-show-matlab-shell-buffer)
+    (define-key km "\M-\t" 'matlab-complete-symbol)
+    (define-key km [(meta control f)] 'matlab-forward-sexp)
+    (define-key km [(meta control b)] 'matlab-backward-sexp)
+    (define-key km [(meta control q)] 'matlab-indent-sexp)
+    (define-key km [(meta control a)] 'matlab-beginning-of-defun)
+    (define-key km [(meta control e)] 'matlab-end-of-defun)
+    (if (string-match "XEmacs" emacs-version)
+	(define-key km [(control meta button1)] 'matlab-find-file-click)
+      (define-key km [(control meta mouse-2)] 'matlab-find-file-click))
+    (substitute-key-definition 'comment-region 'matlab-comment-region
+			       km) ; global-map ;torkel
+    km)
+  "The keymap used in `matlab-mode'.")
+
+;;; Font locking keywords =====================================================
+
+(defvar matlab-string-start-regexp "\\(^\\|[^]})a-zA-Z0-9_.']\\)"
+  "Regexp used to represent the character before the string char '.
+The ' character has restrictions on what starts a string which is needed
+when attempting to understand the current context.")
+
+;; To quote a quote, put two in a row, thus we need an anchored
+;; first quote.  In addition, we don't want to color strings in comments.
+(defvar matlab-string-end-regexp "[^'\n]*\\(''[^'\n]*\\)*'"
+  "Regexp used to represent the character pattern for ending a string.
+The ' character can be used as a transpose, and can transpose transposes.
+Therefore, to end, we must check all that goop.")
+
+(defun matlab-font-lock-string-match-normal (limit)
+  "When font locking strings, call this function for normal strings.
+Argument LIMIT is the maximum distance to scan."
+  (matlab-font-lock-string-match-here
+   (concat matlab-string-start-regexp
+	   "\\('" matlab-string-end-regexp "\\)"
+	   "\\([^']\\|$\\)")
+   limit))
+
+(defun matlab-font-lock-string-match-unterminated (limit)
+  "When font locking strings, call this function for normal strings.
+Argument LIMIT is the maximum distance to scan."
+  (matlab-font-lock-string-match-here
+   (concat matlab-string-start-regexp "\\('[^'\n]*\\(''[^'\n]*\\)*\\)$")
+   limit))
+
+(defun matlab-font-lock-string-match-here (regex limit)
+  "When font-locking strings, call this function to determine a match.
+Argument REGEX is the expression to scan for.  Match 2 must be the string.
+Argument LIMIT is the maximum distance to scan."
+  (let (e)
+    (while (and (re-search-forward regex limit t)
+		(progn
+		  ;; This gets us out of a comment after the string.
+		  (setq e (match-end 2))
+		  (goto-char (match-beginning 2))
+		  (prog1
+		      (or (matlab-cursor-in-comment)
+			  (if (bolp) nil
+			    (save-excursion
+			      (forward-char -1)
+			      (matlab-cursor-in-string))))
+		    (goto-char e))))
+      (setq e nil))
+    (if (not e)
+	nil
+      (goto-char e)
+      t)))
+
+(defun matlab-font-lock-comment-match (limit)
+  "When font-locking comments, call this function to determine a match.
+Argument LIMIT is the maximum distance to scan."
+  (let (e)
+    (while (and (re-search-forward "\\(%[^%\n]*\\)" limit t)
+		(progn
+		  (setq e (match-end 1))
+		  (member (get-text-property (match-beginning 0) 'face)
+			  '(font-lock-string-face
+			    matlab-unterminated-string-face))))
+      (setq e nil))
+    (if (not e)
+	nil
+      (goto-char e)
+      t)))
+
+(defun matlab-find-unreachable-code (limit)
+  "Find code that is if'd out with if(0) or if(false), and mark it as a comment.
+The if(0) and else/end construct should be highlighted differently.
+Argument LIMIT is the maximum distance to search."
+  (if (and (< (point) limit)
+	   (re-search-forward
+	    "\\<\\(if\\>\\s-*(?\\s-*\\(0\\|false\\)\\s-*)?$\\)"
+	    limit t))
+      (let ((b1 (match-beginning 1))
+	    (e1 (match-end 1))
+	    (b2 nil) (e2 nil)
+	    (b3 nil) (e3 nil))
+	(goto-char b1)
+	(condition-case nil
+	    (progn
+	      ;; Go forward over the matlab sexp.  Include scanning
+	      ;; for ELSE since parts of the ELSE block are not
+	      ;; `commented out'.
+	      (matlab-forward-sexp t)
+	      (forward-word -1)
+	      ;; Is there an ELSE in this block?
+	      (if (looking-at (matlab-block-mid-re))
+		  (progn
+		    (setq b3 (match-beginning 0)
+			  e3 (match-end 0))
+		    ;; Now find the REAL end.
+		    (matlab-forward-sexp)
+		    (forward-word -1)))
+	      ;; End of block stuff
+	      (if (looking-at (matlab-block-end-re))
+		  (progn
+		    (setq b2 (match-beginning 0)
+			  e2 (match-end 0))
+		    ;; make sure something exists...
+		    (if (not b3) (setq b3 b2 e3 e2)))
+		(error "Eh?"))
+	      ;; Ok, build up some match data.
+	      (set-match-data
+	       (list b1 e2		;the real deal.
+		     b1 e1		;if (0)
+		     b2 e2		;end
+		     b3 e3		;else (if applicable.)
+		     b1 e3))		;body commented out.
+	      t)
+	  (error nil)))))
+
+(defun matlab-font-lock-nested-function-keyword-match (limit)
+  "Find next nested function/end keyword for font-lock.
+Argument LIMIT is the maximum distance to search."
+; Because of the way overlays are setup, the cursor will be sitting
+; on either a "function" or "end" keyword.
+  (catch 'result
+    (let ((pos (point))
+          overlays)
+      (while (< pos limit)
+        (setq overlays (matlab-overlays-at pos))
+        (while overlays
+          (let ((overlay (car overlays)))
+	    (when (matlab-overlay-get overlay 'nested-function)
+	      (when (= pos (matlab-overlay-start overlay))
+		(goto-char pos)
+		;; The following line presumably returns true.
+		(throw 'result (re-search-forward "function" (+ pos 8) t)))
+	      (let ((end-of-overlay (- (matlab-overlay-end overlay) 3)))
+		(when (<= pos end-of-overlay)
+		  (goto-char end-of-overlay)
+		  (throw 'result
+			 (re-search-forward "end" (+ end-of-overlay 3) t))))))
+          (setq overlays (cdr overlays)))
+        (setq pos (matlab-next-overlay-change pos)))
+      nil ;; no matches, stop
+      )))
+
+(defun matlab-font-lock-cross-function-variables-match (limit)
+  "Find next cross-function variable for font-lock.
+Argument LIMIT is the maximum distance to search."
+  (catch 'result
+    (let ((pos (point))
+          overlays variables)
+      (while (< pos limit)
+        (let ((overlays (matlab-overlays-at pos)))
+	  (while overlays
+	    (let ((overlay (car overlays)))
+	      (setq variables (matlab-overlay-get
+			       overlay 'cross-function-variables))
+	      (if variables
+		  (progn
+		    (goto-char pos)
+		    (setq pos (min limit (matlab-overlay-end overlay)))
+		    (if (re-search-forward variables pos t)
+			(progn
+			  (throw 'result t))))))
+	    (setq overlays (cdr overlays))))
+        (setq pos (matlab-next-overlay-change pos)))
+      nil ;; no matches, stop
+      )))
+
+(defun matlab-find-block-comments (limit)
+  "Find code that is commented out with %{ until %}.
+Argument LIMIT is the maximum distance to search."
+  (if (and (< (point) limit)
+	   (re-search-forward "%{" limit t))
+      (let ((b1 (match-beginning 0))
+	    (e1 (match-end 0))
+	    (b2 nil) (e2 nil)
+	    (b3 nil) (e3 nil))
+	(goto-char b1)
+	(forward-char -1)
+	(when (not (matlab-cursor-in-comment))
+	  (setq b2 (re-search-forward "%}" limit t))
+	  (when b2
+	    (setq b2 (match-beginning 0)
+		  e2 (match-end 0))
+	    (set-match-data
+	     (list b1 e2  ; full match
+		   b1 e2  ; the full comment
+		   b1 e1  ; the block start
+		   b2 e2  ; the block end
+		   ))
+	    t
+	    )))))
+
+(defcustom matlab-keyword-list '("global" "persistent" "for" "parfor" "while"
+				 "spmd" "if" "elseif" "else"
+				 "endfunction" "return" "break" "continue"
+				 "switch" "case" "otherwise" "try"
+				 "catch" "tic" "toc"
+				 ;; MCOS keywords
+				 "classdef" "properties" "methods" "enumeration"
+				 )
+  "List of keywords for MATLAB used in highlighting.
+Customizing this variable is only useful if `regexp-opt' is available."
+  :group 'matlab
+  :type '(repeat (string :tag "Keyword: ")))
+
+(defcustom matlab-handle-graphics-list '("figure" "axes" "axis" "line"
+					"surface" "patch" "text" "light"
+					"image" "set" "get" "uicontrol"
+					"uimenu" "uitoolbar"
+					"uitoggletool" "uipushtool"
+					"uicontext" "uicontextmenu"
+					"setfont" "setcolor")
+  "List of handle graphics functions used in highlighting.
+Customizing this variable is only useful if `regexp-opt' is available."
+  :group 'matlab
+  :type '(repeat (string :tag "HG Keyword: ")))
+
+(defcustom matlab-debug-list '("dbstop" "dbclear" "dbcont" "dbdown" "dbmex"
+			      "dbstack" "dbstatus" "dbstep" "dbtype" "dbup"
+			      "dbquit")
+  "List of debug commands used in highlighting.
+Customizing this variable is only useful if `regexp-opt' is available."
+  :group 'matlab
+  :type '(repeat (string :tag "Debug Keyword: ")))
+
+;; font-lock keywords
+(defvar matlab-font-lock-keywords
+  (list
+   ;; String quote chars are also used as transpose, but only if directly
+   ;; after characters, numbers, underscores, or closing delimiters.
+   '(matlab-font-lock-string-match-normal 2 font-lock-string-face)
+   ;; A string with no termination is not currently highlighted.
+   ;; This will show that the string needs some attention.
+   '(matlab-font-lock-string-match-unterminated
+     2 matlab-unterminated-string-face)
+   ;; Comments must occur after the string, that way we can check to see
+   ;; if the comment start char has occurred inside our string. (EL)
+   '(matlab-font-lock-comment-match 1 font-lock-comment-face)
+   ;; Various pragmas should be in different colors.
+   ;; I think pragmas are always lower case?
+   '("%#\\([a-z]+\\)" (1 'bold prepend))
+   ;; General keywords
+   (list
+    (if (fboundp 'regexp-opt)
+	(concat "\\<\\(" (regexp-opt matlab-keyword-list) "\\)\\>")
+      ;; Original hard-coded value for pre Emacs 20.1
+      "\\<\\(break\\|ca\\(se\\|tch\\)\\|e\\(lse\\(\\|if\\)\\|ndfunction\\)\
+\\|\\(par\\)?for\\|spmd\\|global\\|if\\|otherwise\\|return\\|switch\\|try\\|while\\|tic\\|toc\\)\\>")
+    '(0 font-lock-keyword-face))
+   ;; The end keyword is only a keyword when not used as an array
+   ;; dereferencing part.
+   '("\\(^\\|[;,]\\)[ \t]*\\(end\\)\\b"
+     2 (if (matlab-valid-end-construct-p) font-lock-keyword-face nil))
+   ;; How about unreachable code?  MUsT BE AFTER KEYWORDS in order to
+   ;; get double-highlighting.
+   '(matlab-find-unreachable-code
+     (1 'underline prepend)		;if part
+     (2 'underline prepend)		;end part
+     (3 'underline prepend)		;else part (if applicable)
+     (4 font-lock-comment-face prepend)	;commented out part.
+     )
+   ;; block comments need to be commented out too!
+   '(matlab-find-block-comments
+     (1 font-lock-comment-face prepend) ; commented out
+     (2 'underline prepend)
+     (3 'underline prepend)		;the comment parts
+     )
+   ;; Cell mode breaks get special treatment
+   '("^\\s-*\\(%%[^\n]*\n\\)" (1 matlab-cellbreak-face append))
+   ;; Highlight cross function variables
+   '(matlab-font-lock-cross-function-variables-match
+     (1 matlab-cross-function-variable-face prepend))
+   ;; Highlight nested function/end keywords
+   '(matlab-font-lock-nested-function-keyword-match
+     (0 matlab-nested-function-keyword-face prepend))
+   ;; The global keyword defines some variables.  Mark them.
+   '("^\\s-*global\\s-+"
+     ("\\(\\w+\\)\\(\\s-*=[^,; \t\n]+\\|[, \t;]+\\|$\\)"
+      nil nil (1 font-lock-variable-name-face)))
+   ;; Handle graphics stuff
+   (list
+    (if (fboundp 'regexp-opt)
+	(concat "\\<\\(" (regexp-opt matlab-handle-graphics-list) "\\)\\>")
+      ;; The original regular expression for pre Emacs 20.1
+      "\\<\\(ax\\(es\\|is\\)\\|figure\\|get\\|image\\|li\\(ght\\|ne\\)\\|\
+patch\\|s\\(et\\(\\|color\\|font\\)\\|urface\\)\\|text\\|\
+ui\\(cont\\(ext\\(\\|menu\\)\\|rol\\)\\|menu\\|\
+\\(toggle\\|push\\)tool\\|toolbar\\)\\)\\>")
+    '(0 font-lock-type-face))
+   )
+  "Expressions to highlight in MATLAB mode.")
+
+(defconst matlab-function-arguments
+  "\\(([^)]*)\\)?\\s-*\\([,;\n%]\\|$\\)")
+ 
+(defvar matlab-gaudy-font-lock-keywords
+  (append
+   matlab-font-lock-keywords
+   (list
+    ;; defining a function, a (possibly empty) list of assigned variables,
+    ;; function name, and an optional (possibly empty) list of input variables
+    (list (concat "^\\s-*\\(function\\)\\>[ \t\n.]*"
+		  "\\(\\[[^]]*\\]\\|\\sw+\\)[ \t\n.]*"
+		  "=[ \t\n.]*\\(\\sw+\\)[ \t\n.]*"
+                  matlab-function-arguments)
+	  '(1 font-lock-keyword-face append)
+	  '(2 font-lock-variable-name-face append)
+	  '(3 font-lock-function-name-face append))
+    ;; defining a function, a function name, and an optional (possibly
+    ;; empty) list of input variables
+    (list (concat "^\\s-*\\(function\\)[ \t\n.]+"
+		  "\\(\\sw+\\)[ \t\n.]*"
+                  matlab-function-arguments)
+	  '(1 font-lock-keyword-face append)
+	  '(2 font-lock-function-name-face append))
+    ;; Anchor on the function keyword, highlight params
+    (list (concat "^\\s-*function\\>[ \t\n.]*"
+		  "\\(\\(\\[[^]]*\\]\\|\\sw+\\)[ \t\n.]*=[ \t\n.]*\\)?"
+		  "\\sw+\\s-*(")
+	  '("\\s-*\\(\\sw+\\)\\s-*[,)]" nil nil
+	    (1 font-lock-variable-name-face)))
+    ;; I like variables for FOR loops
+    '("\\<\\(for\\|parfor\\)\\s-+\\(\\sw+\\)\\s-*=\\s-*\
+\\(\\([^\n,;%(]+\\|([^\n%)]+)\\)+\\)"
+      (1 font-lock-keyword-face)
+      (2 font-lock-variable-name-face append)
+      (3 font-lock-reference-face append))
+    ;; Items after a switch statements are cool
+    '("\\<\\(case\\|switch\\)\\s-+\\({[^}\n]+}\\|[^,%\n]+\\)"
+      (1 font-lock-keyword-face) (2 font-lock-reference-face))
+    ;; How about a few matlab constants such as pi, infinity, and sqrt(-1)?
+    ;; The ^>> is in case I use this in an interactive mode someday
+    '("\\<\\(eps\\|pi\\|inf\\|Inf\\|NaN\\|nan\\|ans\\|i\\|j\\|^>>\\)\\>"
+      1 font-lock-reference-face)
+    '("\\<[0-9]\\.?\\(i\\|j\\)\\>" 1 font-lock-reference-face)
+    ;; Define these as variables since this is about as close
+    ;; as matlab gets to variables
+    (list (concat "\\<" matlab-indent-past-arg1-functions "\\s-*")
+	  '("(\\s-*\\(\\w+\\)\\s-*\\(,\\|)\\)" nil nil
+	    (1 font-lock-variable-name-face)))
+    ))
+  "Expressions to highlight in MATLAB mode.")
+
+(defvar matlab-really-gaudy-font-lock-keywords
+  (append
+   matlab-gaudy-font-lock-keywords
+   (list
+    ;; Since it's a math language, how bout dem symbols?
+    '("\\([<>~]=?\\|\\.[/*^']\\|==\\|\\\\|[-!^&|*+\\/~:]\\)"
+      1 font-lock-type-face)
+    ;; How about references in the HELP text.
+    (list (concat "^" matlab-comment-line-s "\\s-*"
+		  "\\(\\([A-Z]+\\s-*=\\s-+\\|\\[[^]]+]\\s-*=\\s-+\\|\\)"
+		  "\\([A-Z][0-9A-Z]+\\)\\(([^)\n]+)\\| \\)\\)")
+	  '(1 font-lock-reference-face prepend))
+    (list (concat "^" matlab-comment-line-s "\\s-*"
+		  "See also\\s-+")
+	  '("\\([A-Z][A-Z0-9]+\\)\\([,.]\\| and\\|$\\) *" nil nil
+	    (1 font-lock-reference-face prepend)))
+    (list (concat "^" matlab-comment-line-s "\\s-*"
+		  "\\(\\$" "Revision" "[^\n$]+\\$\\)")
+	  '(1 font-lock-reference-face prepend))
+    ;; continuation ellipsis.
+    '("[^.]\\(\\.\\.\\.+\\)\\([^\n]*\\)" (1 'underline)
+      (2 font-lock-comment-face))
+    ;; How about debugging statements?
+    ;;'("\\<\\(db\\sw+\\)\\>" 1 'bold)
+    (list
+     (if (fboundp 'regexp-opt)
+	 (concat "\\<\\(" (regexp-opt matlab-debug-list) "\\)\\>")
+       ;; pre-regexp-opt days.
+       "\\<\\(db\\(c\\(lear\\|ont\\)\\|down\\|mex\\|quit\\|\
+st\\(a\\(ck\\|tus\\)\\|ep\\|op\\)\\|type\\|up\\)\\)\\>")
+     '(0 'bold)))
+   (if matlab-handle-simulink
+       ;; Simulink functions, but only if the user wants it.
+       (list (list (concat "\\<\\(\\([sg]et_param\\|sim\\([gs]et\\)?\\|"
+			   "\\(mld\\|ss\\)[A-Z]\\w+\\)\\|"
+			   "\\(new\\|open\\|close\\|save\\|find\\)_system\\|"
+			   "\\(add\\|delete\\|replace\\)_\\(block\\|line\\)\\|"
+			   "simulink\\|bd\\(root\\|close\\)"
+			   "\\)\\>")
+		   1 matlab-simulink-keyword-face))
+     nil))
+  "Expressions to highlight in MATLAB mode.")
+
+(defvar matlab-shell-font-lock-keywords
+  (list
+   ;; How about Errors?
+   '("^\\(Error in\\|Syntax error in\\)\\s-+==>\\s-+\\(.+\\)$"
+     (1 font-lock-comment-face) (2 font-lock-string-face))
+   ;; and line numbers
+   '("^\\(On line [0-9]+\\)" 1 font-lock-comment-face)
+   ;; User beep things
+   '("\\(\\?\\?\\?[^\n]+\\)" 1 font-lock-comment-face)
+   ;; Useful user commands, but not useful programming constructs
+   '("\\<\\(demo\\|whatsnew\\|info\\|subscribe\\|help\\|doc\\|lookfor\\|what\
+\\|whos?\\|cd\\|clear\\|load\\|save\\|helpdesk\\|helpwin\\)\\>"
+     1 font-lock-keyword-face)
+   ;; Various notices
+   '(" M A T L A B " 0 'underline)
+   '("All Rights Reserved" 0 'italic)
+   '("\\((c)\\s-+Copyright[^\n]+\\)" 1 font-lock-comment-face)
+   '("\\(Version\\)\\s-+\\([^\n]+\\)"
+     (1 font-lock-function-name-face) (2 font-lock-variable-name-face))
+   )
+  "Additional keywords used by MATLAB when reporting errors in interactive\
+mode.")
+
+;; Imenu support.
+(defvar matlab-imenu-generic-expression
+  '((nil "^\\s-*function\\>[ \t\n.]*\\(\\(\\[[^]]*\\]\\|\\sw+\\)[ \t\n.]*\
+< =\[ \t\n.]*\\)?\\([a-zA-Z0-9_]+\\)" 3))
+  "Expressions which find function headings in MATLAB M files.")
+
+
+;;; MATLAB mode entry point ==================================================
+
+;;;###autoload
+(add-to-list 'auto-mode-alist '("\\.m$" . matlab-mode))
+
+;;;###autoload
+(defun matlab-mode ()
+  "MATLAB(R) mode is a major mode for editing MATLAB dot-m files.
+\\
+Convenient editing commands are:
+ \\[matlab-comment-region]   - Comment/Uncomment out a region of code.
+ \\[matlab-fill-comment-line] - Fill the current comment line.
+ \\[matlab-fill-region] - Fill code and comments in region.
+ \\[matlab-fill-paragraph]     - Refill the current command or comment.
+ \\[matlab-complete-symbol]   - Symbol completion of matlab symbols\
+based on the local syntax.
+ \\[matlab-indent-sexp] - Indent syntactic block of code.
+
+Convenient navigation commands are:
+ \\[matlab-beginning-of-command]   - Move to the beginning of a command.
+ \\[matlab-end-of-command]   - Move to the end of a command.
+ \\[matlab-beginning-of-defun] - Move to the beginning of a function.
+ \\[matlab-end-of-defun] - Move do the end of a function.
+ \\[matlab-forward-sexp] - Move forward over a syntactic block of code.
+ \\[matlab-backward-sexp] - Move backwards over a syntactic block of code.
+
+Convenient template insertion commands:
+ \\[tempo-template-matlab-function] - Insert a function definition.
+ \\[tempo-template-matlab-if] - Insert an IF END block.
+ \\[tempo-template-matlab-for] - Insert a FOR END block.
+ \\[tempo-template-matlab-switch] - Insert a SWITCH END statement.
+ \\[matlab-insert-next-case] - Insert the next CASE condition in a SWITCH.
+ \\[matlab-insert-end-block] - Insert a matched END statement.  With \
+optional ARG, reindent.
+ \\[matlab-stringify-region] - Convert plaintext in region to a string \
+with correctly quoted chars.
+
+Variables:
+  `matlab-indent-level'		Level to indent blocks.
+  `matlab-cont-level'		Level to indent continuation lines.
+  `matlab-cont-requires-ellipsis' Does your MATLAB support implied elipsis.
+  `matlab-case-level'		Level to unindent case statements.
+  `matlab-indent-past-arg1-functions'
+                                Regexp of functions to indent past the first
+                                  argument on continuation lines.
+  `matlab-maximum-indents'      List of maximum indents during lineups.
+  `matlab-comment-column'       Goal column for on-line comments.
+  `fill-column'			Column used in auto-fill.
+  `matlab-indent-function-body' If non-nil, indents body of MATLAB functions.
+  `matlab-functions-have-end'	If non-nil, MATLAB functions terminate with end.
+  `matlab-return-function'	Customize RET handling with this function.
+  `matlab-auto-fill'            Non-nil, do auto-fill at startup.
+  `matlab-fill-code'            Non-nil, auto-fill code.
+  `matlab-fill-strings'         Non-nil, auto-fill strings.
+  `matlab-verify-on-save-flag'  Non-nil, enable code checks on save.
+  `matlab-highlight-block-match-flag'
+                                Enable matching block begin/end keywords.
+  `matlab-vers-on-startup'	If t, show version on start-up.
+  `matlab-handle-simulink'      If t, enable simulink keyword highlighting.
+
+All Key Bindings:
+\\{matlab-mode-map}"
+  (interactive)
+  (kill-all-local-variables)
+  (use-local-map matlab-mode-map)
+  (setq major-mode 'matlab-mode)
+  (setq mode-name "MATLAB")
+  (if (boundp 'whitespace-modes)
+      (add-to-list 'whitespace-modes 'matlab-mode))
+  (setq local-abbrev-table matlab-mode-abbrev-table)
+  (set-syntax-table matlab-mode-syntax-table)
+  (setq indent-tabs-mode nil)
+  (make-local-variable 'indent-line-function)
+  (setq indent-line-function 'matlab-indent-line)
+  (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 'comment-start-skip)
+  (setq comment-start-skip "%\\s-+")
+  (make-local-variable 'comment-start)
+  (setq comment-start "%")
+  (make-local-variable 'page-delimiter)
+  (setq page-delimiter "^\\(\f\\|%%\\(\\s-\\|\n\\)\\)")
+  (make-local-variable 'comment-column)
+  (setq comment-column matlab-comment-column)
+  (make-local-variable 'comment-indent-function)
+  (setq comment-indent-function 'matlab-comment-indent)
+  (make-local-variable 'add-log-current-defun-function)
+  (setq add-log-current-defun-function 'matlab-current-defun)
+  (make-local-variable 'fill-column)
+  (setq fill-column default-fill-column)
+  (make-local-variable 'auto-fill-function)
+  (if matlab-auto-fill (setq auto-fill-function 'matlab-auto-fill))
+  ;; Emacs 20 supports this variable.  This lets users turn auto-fill
+  ;; on and off and still get the right fill function.
+  (make-local-variable 'normal-auto-fill-function)
+  (setq normal-auto-fill-function 'matlab-auto-fill)
+  (make-local-variable 'fill-prefix)
+  (make-local-variable 'imenu-generic-expression)
+  (setq imenu-generic-expression matlab-imenu-generic-expression)
+  ;; Save hook for verifying src.  This lets us change the name of
+  ;; the function in `write-file' and have the change be saved.
+  ;; It also lets us fix mistakes before a `save-and-go'.
+  (make-local-variable 'write-contents-hooks)
+  (add-hook 'write-contents-hooks 'matlab-mode-verify-fix-file-fn)
+  ;; Tempo tags
+  (make-local-variable 'tempo-local-tags)
+  (setq tempo-local-tags (append matlab-tempo-tags tempo-local-tags))
+  ;; give each file it's own parameter history
+  (make-local-variable 'matlab-shell-save-and-go-history)
+  (make-local-variable 'font-lock-defaults)
+  (setq font-lock-defaults '((matlab-font-lock-keywords
+			      matlab-gaudy-font-lock-keywords
+			      matlab-really-gaudy-font-lock-keywords
+			      )
+			     t ; do not do string/comment highlighting
+			     nil ; keywords are case sensitive.
+			     ;; This puts _ as a word constituent,
+			     ;; simplifying our keywords significantly
+			     ((?_ . "w"))))
+  (matlab-enable-block-highlighting 1)
+  (if window-system (matlab-frame-init))
+
+  ;; If first function is terminated with an end statement, then functions have
+  ;; ends.
+  (if (matlab-do-functions-have-end-p)
+      (matlab-functions-have-end-minor-mode 1)
+    (matlab-functions-have-end-minor-mode -1)
+    )
+
+  ;; When matlab-indent-function-body is set to 'MathWorks-Standard,
+  ;;    - we indent all functions that terminate with an end statement
+  ;;    - old style functions (those without end statements) are not
+  ;;      indented.
+  ;; It is desired that all code be terminate with an end statement.
+  ;;
+  ;; When matlab-indent-function-body is set to 'guess,
+  ;;    - look at the first line of code and if indented, keep indentation
+  ;;      otherwise use MathWorks-Standard
+  ;;
+  (cond
+   ((eq matlab-indent-function-body 'MathWorks-Standard)
+    )
+
+   ((eq matlab-indent-function-body 'guess)
+    (save-excursion
+      (goto-char (point-max))
+
+      (if (re-search-backward matlab-defun-regex nil t)
+	  (let ((beg (point))
+		end			; filled in later
+		(cc (current-column))
+		)
+	    (setq end (if matlab-functions-have-end
+			  (progn (forward-line 0) (point))
+			(point-max)))
+	    (goto-char beg)
+	    (catch 'done
+	      (while (progn (forward-line 1) (< (point) end))
+		(if (looking-at "\\s-*\\(%\\|$\\)")
+		    nil			; go on to next line
+		  (looking-at "\\s-*")
+		  (goto-char (match-end 0))
+		  (setq matlab-indent-function-body (> (current-column) cc))
+		  (throw 'done nil))))
+	    )
+	(setq matlab-indent-function-body 'MathWorks-Standard)
+	))
+    )
+    
+   (t)
+   )
+
+
+  (if (or (featurep 'mlint)
+	  matlab-show-mlint-warnings
+	  matlab-highlight-cross-function-variables)
+      ;; Some users may not feel like getting all the extra stuff
+      ;; needed for mlint working.  Do this only if we can get
+      ;; mlint loaded ok.
+      (condition-case nil
+	  (mlint-minor-mode
+	   (if (or matlab-show-mlint-warnings matlab-highlight-cross-function-variables)
+	       1
+	     0))
+	;; If there is an error loading the stuff, don't
+	;; continue.
+	(error nil)))
+  (save-excursion
+    (goto-char (point-min))
+    (run-hooks 'matlab-mode-hook))
+  (if matlab-vers-on-startup (matlab-show-version)))
+
+;;; Utilities =================================================================
+
+(defun matlab-show-version ()
+  "Show the version number in the minibuffer."
+  (interactive)
+  (message "matlab-mode, version %s" matlab-mode-version))
+
+(defun matlab-find-prev-line ()
+  "Recurse backwards until a code line is found."
+  (if (= -1 (forward-line -1)) nil
+    (if (or (matlab-ltype-empty)
+	    (matlab-ltype-comm-ignore))
+	(matlab-find-prev-line) t)))
+
+(defun matlab-prev-line ()
+  "Go to the previous line of code.  Return nil if not found."
+  (interactive)
+  (let ((old-point (point)))
+    (if (matlab-find-prev-line) t (goto-char old-point) nil)))
+
+(defun matlab-uniquafy-list (lst)
+  "Return a list that is a subset of LST where all elements are unique."
+  (let ((nlst nil))
+    (while lst
+      (if (and (car lst) (not (member (car lst) nlst)))
+	  (setq nlst (cons (car lst) nlst)))
+      (setq lst (cdr lst)))
+    (nreverse nlst)))
+
+; Aki Vehtari  recommends this: (19.29 required)
+;(require 'backquote)
+;(defmacro matlab-navigation-syntax (&rest body)
+;  "Evaluate BODY with the matlab-mode-special-syntax-table"
+;  '(let	((oldsyntax (syntax-table)))
+;    (unwind-protect
+;	(progn
+;	  (set-syntax-table matlab-mode-special-syntax-table)
+;	   ,@body)
+;      (set-syntax-table oldsyntax))))
+
+(defmacro matlab-navigation-syntax (&rest forms)
+  "Set the current environment for syntax-navigation and execute FORMS."
+  (list 'let '((oldsyntax (syntax-table))
+	       (case-fold-search nil))
+	 (list 'unwind-protect
+		(list 'progn
+		       '(set-syntax-table matlab-mode-special-syntax-table)
+			(cons 'progn forms))
+		'(set-syntax-table oldsyntax))))
+
+(put 'matlab-navigation-syntax 'lisp-indent-function 0)
+(add-hook 'edebug-setup-hook
+	  (lambda ()
+	    (def-edebug-spec matlab-navigation-syntax def-body)))
+
+(defun matlab-up-list (count &optional restrict)
+  "Move forwards or backwards up a list by COUNT.
+Optional argument RESTRICT is where to restrict the search."
+  ;; MATLAB syntax table has no disabling strings or comments.
+  (let ((dir (if (> 0 count) -1 +1))
+	(origin (point))
+	(ms nil))
+    ;; Make count positive
+    (setq count (* count dir))
+    (if (= dir -1)
+	(while (/= count 0)
+	  ;; Search till we find an unstrung paren object.
+	  (setq ms (re-search-backward "\\s(\\|\\s)" restrict t))
+	  (while (and (save-match-data (matlab-cursor-in-string-or-comment))
+		      (setq ms (re-search-backward "\\s(\\|\\s)" restrict t))))
+	  (if (not ms)
+	      (progn
+		(goto-char origin)
+		(error "Scan Error: List missmatch")))
+	  ;; View it's match.
+	  (let ((s (match-string 0)))
+	    (if (string-match "\\s(" s)
+		(setq count (1- count))
+	      (setq count (1+ count)))))
+      (error "Not implemented"))
+    ms))
+
+(defun matlab-valid-end-construct-p ()
+  "Return non-nil if the end after point terminates a block.
+Return nil if it is being used to dereference an array."
+  (let ((p (point))
+	(err1 t))
+    (condition-case nil
+	(save-restriction
+	  ;; Restrict navigation only to the current command line
+	  (save-excursion
+	    (matlab-beginning-of-command)
+	    (narrow-to-region (point)
+			      (save-excursion
+				(goto-char p)
+				(matlab-point-at-eol))))
+	    ;; This used to add some sort of protection, but I don't know what
+	    ;; the condition was, or why the simple case doesn't handle it.
+	    ;;
+	    ;; The above replacement fixes a case where a continuation in an array
+	    ;; befuddles the indenter.
+	    ;;		      (progn ;;(matlab-end-of-command (point))
+	    ;;			(end-of-line)
+	    ;;			(if (> p (point))
+	    ;;			    (progn
+	    ;;			      (setq err1 nil)
+	    ;;			      (error)))
+	    ;;    		(point))))
+	  (save-excursion
+	    ;; beginning of param list
+	    (matlab-up-list -1)
+	    ;; backup over the parens.  If that fails
+	    (condition-case nil
+		(progn
+		  (forward-sexp 1)
+		  ;; If we get here, the END is inside parens, which is not a
+		  ;; valid location for the END keyword.  As such it is being
+		  ;; used to dereference array parameters
+		  nil)
+	      ;; This error means that we have an unterminated paren
+	      ;; block, so this end is currently invalid.
+	      (error nil))))
+      ;; an error means the list navigation failed, which also means we are
+      ;; at the top-level
+      (error err1))))
+
+;;; Regexps for MATLAB language ===============================================
+
+;; "-pre" means "partial regular expression"
+;; "-if" and "-no-if" means "[no] Indent Function"
+
+(defconst matlab-defun-regex "^\\(\\s-*function\\|classdef\\)[ \t.[]"
+  "Regular expression defining the beginning of a MATLAB function.")
+
+(defconst matlab-mcos-regexp "\\|classdef\\|properties\\|methods\\|enumeration"
+  "Keywords which mark the beginning of mcos blocks.")
+
+(defcustom matlab-block-indent-tic-toc-flag nil
+  "*Non-nil means that tic,toc should indent like a if,end block.
+This variable should be set before loading matlab.el"
+  :group 'matlab
+  :type 'boolean)
+
+(defconst matlab-block-beg-pre-if
+  (if matlab-block-indent-tic-toc-flag
+      (concat "function\\|parfor\\|spmd\\|for\\|while\\|if\\|switch\\|try\\|tic"
+	      matlab-mcos-regexp)
+    (concat "function\\|parfor\\|spmd\\|for\\|while\\|if\\|switch\\|try"
+	    matlab-mcos-regexp))
+  "Keywords which mark the beginning of an indented block.
+Includes function.")
+
+(defconst matlab-block-beg-pre-no-if
+  (if matlab-block-indent-tic-toc-flag
+      (concat "parfor\\|for\\|spmd\\|while\\|if\\|switch\\|try\\|tic"
+	      matlab-mcos-regexp)
+    (concat "parfor\\|for\\|spmd\\|while\\|if\\|switch\\|try"
+	    matlab-mcos-regexp))
+  "Keywords which mark the beginning of an indented block.
+Excludes function.")
+
+(defun matlab-block-beg-pre ()
+  "Partial regular expression to recognize MATLAB block-begin keywords."
+  (if matlab-functions-have-end
+      matlab-block-beg-pre-if
+    matlab-block-beg-pre-no-if))
+
+(defconst matlab-block-mid-pre
+  "elseif\\|else\\|catch"
+  "Partial regular expression to recognize MATLAB mid-block keywords.")
+
+(defconst matlab-block-end-pre-if
+  (if matlab-block-indent-tic-toc-flag
+      "end\\(function\\)?\\|function\\|\\(\\sw+\\s-*\\((.*)\\)?\\s-*=\\s-*\\)?toc"
+    "end\\(function\\)?\\|function")
+  "Partial regular expression to recognize MATLAB block-end keywords.")
+
+(defconst matlab-block-end-pre-no-if
+  (if matlab-block-indent-tic-toc-flag
+      "end\\|\\(\\sw+\\s-*\\((.*)\\)?\\s-*=\\s-*\\)?toc"
+    "end")
+  "Partial regular expression to recognize MATLAB block-end keywords.")
+
+(defun matlab-block-end-pre ()
+  "Partial regular expression to recognize MATLAB block-end keywords."
+  (if matlab-functions-have-end
+      matlab-block-end-pre-if
+    matlab-block-end-pre-no-if))
+
+;; Not used.
+;;(defconst matlab-other-pre
+;;  "function\\|return"
+;;  "Partial regular express to recognize MATLAB non-block keywords.")
+
+(defconst matlab-endless-blocks
+  "case\\|otherwise"
+  "Keywords which initialize new blocks, but don't have explicit ends.
+Thus, they are endless.  A new case or otherwise will end a previous
+endless block, and and end will end this block, plus any outside normal
+blocks.")
+
+(defun matlab-block-re ()
+  "Regular expression for keywords which begin MATLAB blocks."
+  (concat "\\(^\\|[;,]\\)\\s-*\\("
+ 	  (matlab-block-beg-pre) "\\|"
+  	  matlab-block-mid-pre "\\|"
+ 	  (matlab-block-end-pre) "\\|"
+ 	  matlab-endless-blocks "\\)\\b"))
+  
+(defun matlab-block-scan-re ()
+  "Expression used to scan over matching pairs of begin/ends."
+  (concat "\\(^\\|[;,]\\)\\s-*\\("
+ 	  (matlab-block-beg-pre) "\\|"
+ 	  (matlab-block-end-pre) "\\)\\b"))
+
+(defun matlab-block-beg-re ()
+  "Expression used to find the beginning of a block."
+  (concat "\\(" (matlab-block-beg-pre) "\\)"))
+
+(defun matlab-block-mid-re ()
+  "Expression used to find block center parts (like else)."
+  (concat "\\(" matlab-block-mid-pre "\\)"))
+
+(defun matlab-block-end-re ()
+  "Expression used to end a block.  Usually just `end'."
+  (concat "\\(" (matlab-block-end-pre) "\\)"))
+
+(defun matlab-block-end-no-function-re ()
+  "Expression representing and end if functions are excluded."
+  (concat "\\<\\(" matlab-block-end-pre-no-if "\\)\\>"))
+
+(defun matlab-endless-blocks-re ()
+  "Expression of block starters that do not have associated ends."
+  (concat "\\(" matlab-endless-blocks "\\)"))
+
+(defun matlab-match-function-re ()
+  "Expression to match a function start line.
+There are no reliable numeric matches in this expression.
+Know that `match-end' of 0 is the end of the functin name."
+  ;; old function was too unstable.
+  ;;"\\(^function\\s-+\\)\\([^=\n]+=[ \t\n.]*\\)?\\(\\sw+\\)"
+  (concat "\\(^\\s-*function\\b[ \t\n.]*\\)\\(\\(\\[[^]]*\\]\\|\\sw+\\)"
+	  "[ \t\n.]*=[ \t\n.]*\\|\\(\\)\\)\\(\\sw+\\)"))
+
+(defconst matlab-cline-start-skip "[ \t]*%[ \t]*"
+  "*The regular expression for skipping comment start.")
+
+;;; Lists for matlab keywords =================================================
+
+(defvar matlab-keywords-solo
+  '("break" "case" "else" "elseif" "end" "for" "parfor" "function" "if" "tic" "toc"
+    "otherwise" "profile" "switch" "while" "try" "catch" "spmd")
+  "Keywords that appear on a line by themselves.")
+(defvar matlab-keywords-return
+  '("acos" "acosh" "acot" "acoth" "acsch" "asech" "asin" "asinh"
+    "atan" "atan2" "atanh" "cos" "cosh" "coth" "csc" "csch" "exp"
+    "log" "log10" "log2" "sec" "sech" "sin" "sinh" "tanh"
+    "abs" "sign" "sqrt" )
+  "List of MATLAB keywords that have return arguments.
+This list still needs lots of help.")
+(defvar matlab-keywords-boolean
+  '("all" "any" "exist" "isempty" "isequal" "ishold" "isfinite" "isglobal"
+    "isinf" "isletter" "islogical" "isnan" "isprime" "isreal" "isspace"
+    "logical" "isa")
+  "List of keywords that are typically used as boolean expressions.")
+
+(defvar matlab-core-properties
+  '("ButtonDownFcn" "Children" "Clipping" "CreateFcn" "DeleteFcn"
+    "BusyAction" "HandleVisibility" "HitTest" "Interruptible"
+    "Parent" "Selected" "SelectionHighlight" "Tag" "Type"
+    "UIContextMenu" "UserData" "Visible")
+  "List of properties belonging to all HG objects.")
+
+(defvar matlab-property-lists
+  '(("root" .
+     ("CallbackObject" "Language" "CurrentFigure" "Diary" "DiaryFile"
+      "Echo" "ErrorMessage" "Format" "FormatSpacing" "PointerLocation"
+      "MonitorPositions"
+      "PointerWindow" "Profile" "ProfileFile" "ProfileCount"
+      "ProfileInterval" "RecursionLimit" "ScreenDepth" "ScreenSize"
+      "ShowHiddenHandles" "TerminalHideGraphCommand" "TerminalOneWindow"
+      "TerminalDimensions" "TerminalProtocol" "TerminalShowGraphCommand"
+      "Units" "AutomaticFileUpdates" ))
+    ("axes" .
+     ("AmbientLightColor" "Box" "CameraPosition" "CameraPositionMode"
+      "CameraTarget" "CameraTargetMode" "CameraUpVector"
+      "CameraUpVectorMode" "CameraViewAngle" "CameraViewAngleMode" "CLim"
+      "CLimMode" "Color" "CurrentPoint" "ColorOrder" "DataAspectRatio"
+      "DataAspectRatioMode" "DrawMode" "FontAngle" "FontName" "FontSize"
+      "FontUnits" "FontWeight" "GridLineStyle" "Layer" "LineStyleOrder"
+      "LineWidth" "NextPlot" "PlotBoxAspectRatio" "PlotBoxAspectRatioMode"
+      "Projection" "Position" "TickLength" "TickDir" "TickDirMode" "Title"
+      "Units" "View" "XColor" "XDir" "XGrid" "XLabel" "XAxisLocation" "XLim"
+      "XLimMode" "XScale" "XTick" "XTickLabel" "XTickLabelMode" "XTickMode"
+      "YColor" "YDir" "YGrid" "YLabel" "YAxisLocation" "YLim" "YLimMode"
+      "YScale" "YTick" "YTickLabel" "YTickLabelMode" "YTickMode" "ZColor"
+      "ZDir" "ZGrid" "ZLabel" "ZLim" "ZLimMode" "ZScale" "ZTick"
+      "ZTickLabel" "ZTickLabelMode" "ZTickMode"))
+    ("figure" .
+     ("BackingStore" "CloseRequestFcn" "Color" "Colormap"
+      "CurrentAxes" "CurrentCharacter" "CurrentObject" "CurrentPoint"
+      "Dithermap" "DithermapMode" "FixedColors" "IntegerHandle"
+      "InvertHardcopy" "KeyPressFcn" "MenuBar" "MinColormap" "Name"
+      "NextPlot" "NumberTitle" "PaperUnits" "PaperOrientation"
+      "PaperPosition" "PaperPositionMode" "PaperSize" "PaperType"
+      "Pointer" "PointerShapeCData" "PointerShapeHotSpot" "Position"
+      "Renderer" "RendererMode" "Resize" "ResizeFcn" "SelectionType"
+      "ShareColors" "Units" "WindowButtonDownFcn"
+      "WindowButtonMotionFcn" "WindowButtonUpFcn" "WindowStyle"))
+    ("image" . ("CData" "CDataMapping" "EraseMode" "XData" "YData"))
+    ("light" . ("Position" "Color" "Style"))
+    ("line" .
+     ("Color" "EraseMode" "LineStyle" "LineWidth" "Marker" "LineSmoothing"
+      "MarkerSize" "MarkerEdgeColor" "MarkerFaceColor" "XData" "YData"
+      "ZData"))
+    ("patch" .
+     ("CData" "CDataMapping" "FaceVertexCData" "EdgeColor" "EraseMode"
+      "FaceColor" "Faces" "LineStyle" "LineWidth" "Marker" "LineSmoothing"
+      "MarkerEdgeColor" "MarkerFaceColor" "MarkerSize" "Vertices"
+      "XData" "YData" "ZData" "FaceLighting" "EdgeLighting"
+      "BackFaceLighting" "AmbientStrength" "DiffuseStrength"
+      "SpecularStrength" "SpecularExponent" "SpecularColorReflectance"
+      "VertexNormals" "NormalMode"))
+    ("surface" .
+     ("CData" "CDataMapping" "EdgeColor" "EraseMode" "FaceColor"
+      "LineStyle" "LineWidth" "Marker" "MarkerEdgeColor" "LineSmoothing"
+      "MarkerFaceColor" "MarkerSize" "MeshStyle" "XData" "YData"
+      "ZData" "FaceLighting" "EdgeLighting" "BackFaceLighting"
+      "AmbientStrength" "DiffuseStrength" "SpecularStrength"
+      "SpecularExponent" "SpecularColorReflectance" "VertexNormals"
+      "NormalMode"))
+    ("text\\|title\\|xlabel\\|ylabel\\|zlabel" .
+     ("Color" "EraseMode" "Editing" "Extent" "FontAngle" "FontName"
+      "FontSize" "FontUnits" "FontWeight" "HorizontalAlignment"
+      "BackgroundColor" "EdgeColor" "Margin"
+      "Position" "Rotation" "String" "Units" "Interpreter"
+      "VerticalAlignment"))
+    ("uicontextmenu" . ("Callback"))
+    ("uicontrol" .
+     ("BackgroundColor" "Callback" "CData" "Enable" "Extent"
+      "FontAngle" "FontName" "FontSize" "FontUnits" "FontWeight"
+      "ForegroundColor" "HorizontalAlignment" "ListboxTop" "Max" "Min"
+      "Position" "String" "Style" "SliderStep" "TooltipString" "Units"
+      "Value"))
+    ("uimenu" .
+     ("Accelerator" "Callback" "Checked" "Enable" "ForegroundColor"
+      "Label" "Position" "Separator"))
+    ;; Flesh this out more later.
+    ("uipushtool\\|uitoggletool\\|uitoolbar" .
+     ("Cdata" "Callback" "Separator" "Visible"))
+    )
+  "List of property lists on a per object type basis.")
+
+(defvar matlab-unknown-type-commands
+  "[gs]et\\|findobj\\|waitfor"
+  "Expression for commands that have unknown types.")
+
+(defun matlab-all-known-properties ()
+  "Return a list of all properties."
+  (let ((lst matlab-core-properties)
+	(tl matlab-property-lists))
+    (while tl
+      (setq lst (append lst (cdr (car tl)))
+	    tl (cdr tl)))
+    (matlab-uniquafy-list lst)))
+
+(defvar matlab-all-known-properties (matlab-all-known-properties)
+  "List of all the known properties.")
+
+(defmacro matlab-property-function ()
+  "Regexp of all builtin functions that take property lists."
+  '(let ((r matlab-unknown-type-commands)
+	 (tl matlab-property-lists))
+     (while tl
+       (setq r (concat r "\\|" (car (car tl)))
+	     tl (cdr tl)))
+     r))
+
+;;; Navigation ===============================================================
+
+(defvar matlab-scan-on-screen-only nil
+  "When this is set to non-nil, then forward/backward sexp stops off screen.
+This is so the block highlighter doesn't gobble up lots of time when
+a block is not terminated.")
+
+(defun matlab-backward-sexp (&optional autoend noerror)
+  "Go backwards one balanced set of MATLAB expressions.
+If optional AUTOEND, then pretend we are at an end.
+If optional NOERROR, then we return t on success, and nil on failure.
+This assumes that expressions do not cross \"function\" at the left margin."
+  (interactive "P")
+  (matlab-navigation-syntax
+    (if (and (not autoend)
+	     (save-excursion (backward-word 1)
+			     (or (not
+				  (and (looking-at
+					(matlab-block-end-no-function-re))
+				       (matlab-valid-end-construct-p)))
+				 (matlab-cursor-in-string-or-comment))))
+	;; Go backwards one simple expression
+	(forward-sexp -1)
+      ;; otherwise go backwards recursively across balanced expressions
+      ;; backup over our end
+      (if (not autoend) (forward-word -1))
+      (let ((done nil) (start (point)) (returnme t) (bound nil))
+        (when (search-backward "\nfunction" nil t)
+          (if (progn (forward-char 9) (looking-at "\\b"))
+              (setq bound (- (point) 8)))
+          (goto-char start))
+	(while (and (not done)
+		    (or (not matlab-scan-on-screen-only)
+			(pos-visible-in-window-p)))
+	  (if (re-search-backward (matlab-block-scan-re) bound t)
+	      (progn
+		(goto-char (match-beginning 2))
+		(if (looking-at (matlab-block-end-no-function-re))
+		    (if (or (matlab-cursor-in-string-or-comment)
+			    (not (matlab-valid-end-construct-p)))
+			nil
+		      ;; we must skip the expression and keep searching
+		      (forward-word 1)
+		      (matlab-backward-sexp))
+		  (if (not (matlab-cursor-in-string-or-comment))
+		      (setq done t))))
+	    (goto-char start)
+	    (if noerror
+		(setq returnme nil)
+	      (error "Unstarted END construct"))))
+	returnme))))
+  
+(defun matlab-forward-sexp (&optional includeelse)
+  "Go forward one balanced set of MATLAB expressions.
+Optional argument INCLUDEELSE will stop on ELSE if it matches the starting IF."
+  (interactive "P")
+  (let (p) ;; go to here if no error.
+    (save-excursion ;; don't go anywhere if there is an error
+      (matlab-navigation-syntax
+        ;; skip over preceeding whitespace
+        (skip-chars-forward " \t\n;")
+        (if (or (not (looking-at (concat "\\("
+                                         (matlab-block-beg-pre)
+                                         "\\|"
+                                         (matlab-block-mid-re)
+                                         "\\)\\>")))
+                (matlab-cursor-in-string-or-comment))
+            ;; Go forwards one simple expression
+            (forward-sexp 1)
+          ;; otherwise go forwards recursively across balanced expressions
+          (forward-word 1)
+          (let ((done nil) (s nil)
+                (expr-scan (if includeelse
+                               (matlab-block-re)
+                             (matlab-block-scan-re)))
+                (expr-look (matlab-block-beg-pre)))
+            (while (and (not done)
+                        (setq s (re-search-forward expr-scan nil t))
+                        (or (not matlab-scan-on-screen-only)
+                            (pos-visible-in-window-p)))
+              (goto-char (match-beginning 2))
+              (if (looking-at expr-look)
+                  (if (matlab-cursor-in-string-or-comment)
+                      (forward-word 1)
+                    ;; we must skip the expression and keep searching
+                    ;; NEVER EVER call with value of INCLUDEELSE
+                    (matlab-forward-sexp))
+                (forward-word 1)
+                (if (and (not (matlab-cursor-in-string-or-comment))
+                         (matlab-valid-end-construct-p))
+                    (setq done t))))
+            (if (not s)
+                (error "Unterminated block"))))
+        (setq p (point)))) ;; really go here
+    (goto-char p)))
+
+(defun matlab-indent-sexp ()
+  "Indent the syntactic block starting at point."
+  (interactive)
+  (indent-region (point) (save-excursion (matlab-forward-sexp) (point)) nil))
+
+(defun matlab-beginning-of-enclosing-defun ()
+  "Move cursor to beginning of enclosing function.
+If `matlab-functions-have-end', skip over functions with end."
+  (catch 'done
+    (let ((start (point))
+          (beg nil))
+      (while (re-search-backward matlab-defun-regex nil t)
+        (setq beg (point))
+        (condition-case nil
+            (progn
+              (matlab-forward-sexp)
+              (if (> (point) start) (throw 'done beg)))
+          (error (throw 'done beg)))
+        (goto-char beg)))
+    nil))
+
+(defun matlab-beginning-of-defun ()
+  "Go to the beginning of the current function."
+  (interactive)
+  (if matlab-functions-have-end
+      (goto-char (or (matlab-beginning-of-enclosing-defun) (point-min)))
+    (or (re-search-backward matlab-defun-regex nil t)
+        (goto-char (point-min)))))
+
+(defun matlab-end-of-defun ()
+  "Go to the end of the current function."
+  (interactive)
+  (or (progn
+	(if (looking-at matlab-defun-regex) (goto-char (match-end 0)))
+	(if (re-search-forward matlab-defun-regex nil t)
+	    (progn (forward-line -1)
+		   t)))
+      (goto-char (point-max))))
+
+(defun matlab-current-defun ()
+  "Return the name of the current function."
+  (save-excursion
+    (matlab-beginning-of-defun)
+    (if (looking-at (matlab-match-function-re))
+	(progn
+	  (goto-char (match-end 0))
+	  (current-word)))))
+
+(defun matlab-beginning-of-command ()
+  "Go to the beginning of an M command.
+Travels across continuations."
+  (interactive)
+  (beginning-of-line)
+  (let ((p nil)
+	;; This restriction is a wild guess where to end reverse
+	;; searching for array continuations.  The reason is that
+	;; matlab up list is very slow, and most people would never
+	;; put a blank line in a matrix.  Either way, it's worth the
+	;; trade off to speed this up for large files.
+	;; This list of keywords is NOT meant to be comprehensive.
+	(r (save-excursion
+	     (re-search-backward
+	      "^\\s-*\\(%\\|if\\|else\\(if\\)\\|while\\|\\(par\\)?for\\|$\\)\\>"
+	      nil t))))
+    (while (and (or (save-excursion (and (matlab-prev-line)
+					 (matlab-lattr-cont)))
+		    (matlab-ltype-continued-comm)
+		    (setq p (matlab-lattr-array-cont r)))
+		(save-excursion (beginning-of-line) (not (bobp))))
+      (if p (goto-char p) (matlab-prev-line))
+      (setq p nil))
+    (back-to-indentation)))
+
+(defun matlab-end-of-command (&optional beginning)
+  "Go to the end of an M command.
+Optional BEGINNING is where the command starts from."
+  (interactive)
+  (while (and (or (matlab-lattr-cont)
+		  (save-excursion
+		    (forward-line 1)
+                    (or (matlab-ltype-continued-comm)
+                        (matlab-lattr-array-cont beginning))))
+	      ;; This hack is a short circuit.  If a user did not
+	      ;; correctly end a matrix, this will short-circuit
+	      ;; as soon as somethng that would never appear in a matrix
+	      ;; becomes visible.
+	      (not (save-excursion
+		     (beginning-of-line)
+		     (looking-at (matlab-block-scan-re))))
+              ;; If we hit the end of the buffer unexpectedly, this test
+              ;; will fail and we'll avoid looping forever.  (E.g., this
+              ;; is triggered if a continuation line is the last one in
+              ;; the buffer, and the line lacks the final newline.)
+              (zerop (forward-line 1))))
+  (end-of-line))
+
+
+;;; Line types and attributes =================================================
+
+(defun matlab-ltype-empty ()		; blank line
+  "Return t if current line is empty."
+  (save-excursion
+    (beginning-of-line)
+    (looking-at "^[ \t]*$")))
+
+(defun matlab-ltype-comm ()		; comment line
+  "Return t if current line is a MATLAB comment line.
+Return the symbol 'cellstart if it is a double %%.
+Return the symbol 'blockcomm if it is a block comment start."
+  (save-excursion
+    (beginning-of-line)
+    (cond ((looking-at "[ \t]*%\\([^%]\\|$\\)")
+	   t)
+	  ((looking-at "[ \t]*%%")
+	   'cellstart)
+          ((matlab-ltype-block-comm)
+           'blockcomm)
+	  (t nil))))
+
+(defun matlab-ltype-comm-ignore ()	; comment out a region line
+  "Return t if current line is a MATLAB comment region line."
+  (save-excursion
+    (beginning-of-line)
+    (looking-at (concat "[ \t]*" matlab-comment-region-s))))
+
+(defun matlab-ltype-help-comm ()
+  "Return t if the current line is part of the MATLAB help comment."
+  (save-excursion
+    (if (not (matlab-ltype-comm))
+	nil
+      (while (and (matlab-ltype-comm) (not (bobp))
+		  (matlab-prev-line))
+	(beginning-of-line))
+      (matlab-ltype-function-definition))))
+
+(defun matlab-ltype-block-comm ()
+  "Return t if we are in a block comment."
+  (save-excursion
+    (if (looking-at "%{")
+        t
+      (when (re-search-backward "\\%\\([{}]\\)" nil t)
+        (let ((ms (match-string 1)))
+          (if (string= ms "{") t nil))))))
+
+(defun matlab-ltype-endfunction-comm ()
+  "Return t if the current line is an ENDFUNCTION style comment."
+  (save-excursion
+    (if (not (matlab-ltype-comm))
+	nil
+      (beginning-of-line)
+      (if (looking-at "^[ \t]*%[ \t]*endfunction")
+	  t
+	(while (and (or (matlab-ltype-comm)
+			(matlab-ltype-empty))
+		    (not (eobp)))
+	  (forward-line 1))
+	(and (matlab-ltype-function-definition)
+	     (not (save-excursion (matlab-beginning-of-enclosing-defun))))
+	))))
+
+(defun matlab-ltype-continued-comm ()
+  "Return column of previous line's comment start, or nil."
+  (save-excursion
+    (beginning-of-line)
+    (let ((commtype (matlab-ltype-comm)))
+      (if (or (eq commtype 'cellstart) ;; Cells are not continuations from previous comments.
+	      (null commtype)
+	      (bobp))
+	  nil
+	;; We use forward-line and not matlab-prev-line because
+	;; we want blank lines to terminate this indentation method.
+	(forward-line -1)
+	(let ((col  (matlab-lattr-comm)))
+	  (if col
+	      (progn
+		(goto-char col)
+		(current-column))
+	    nil))))))
+
+(defun matlab-ltype-function-definition ()
+  "Return t if the current line is a function definition."
+  (save-excursion
+    (beginning-of-line)
+    (looking-at matlab-defun-regex)))
+
+(defun matlab-ltype-code ()		; line of code
+  "Return t if current line is a MATLAB code line."
+  (and (not (matlab-ltype-empty)) (not (matlab-ltype-comm))))
+
+(defun matlab-lattr-comm ()		; line has comment
+  "Return t if current line contain a comment."
+  (save-excursion (matlab-comment-on-line)))
+
+(defun matlab-lattr-implied-continuation ()
+  "Return non-nil if this line has implied continuation on the next.
+This is only useful for new versions of MATLAB where ... is optional."
+  (when (not (matlab-lattr-comm))
+    (let ((imp nil))
+      (save-excursion
+	(end-of-line)
+	(skip-chars-backward " \t")
+	;; Test for oporator incompleteness.
+	(setq imp
+	      (/= (point)
+		  ;; Careful, - means range in this expression.
+		  (progn (skip-chars-backward "-+=/*.^&~<>")
+			 (point))))
+	(if (not imp)
+	    ;; Test for argument list incompleteness
+	    (condition-case nil
+		(progn
+		  (end-of-line)
+		  (matlab-up-list -1)
+		  (setq imp (looking-at "(")))
+	      (error nil)))
+	)
+      imp)))
+
+(defun matlab-lattr-cont ()		; line has continuation
+  "Return non-nil if current line ends in ... and optional comment.
+If `matlab-cont-requires-ellipsis' is nil, then we need to apply
+a heuristic to determine if this line would use continuation
+based on what it ends with."
+  (save-excursion
+    (beginning-of-line)
+    (or
+     ;; Here, if the line ends in ..., then it is what we are supposed to do.
+     (and (re-search-forward "[^ \t.][ \t]*\\.\\.+[ \t]*\\(%.*\\)?$"
+				(matlab-point-at-eol) t)
+	  (progn (goto-char (match-beginning 0))
+		 (not (matlab-cursor-in-comment))))
+     ;; If the line doesn't end in ..., but we have optional ..., then
+     ;; use this annoying heuristic.
+     (and (null matlab-cont-requires-ellipsis)
+	  (matlab-lattr-implied-continuation))
+     )))
+
+(defun matlab-lattr-array-cont (&optional restrict)
+  "Return non-nil if current line is in an array.
+If the entirety of the array is on this line, return nil.
+Optional option RESTRICT is the distrance to restrict the search."
+  (condition-case nil
+      (save-excursion
+	(beginning-of-line)
+	(matlab-up-list -1 restrict)
+	(and (looking-at "[[{]") (point)))
+    (error nil)))
+
+(defun matlab-lattr-array-end ()
+  "Return non-nil if the current line closes an array.
+by close, the first character is the end of an array."
+  (save-excursion
+    (back-to-indentation)
+    (and (looking-at "[]}]") (matlab-lattr-array-cont))))
+
+(defun matlab-lattr-block-cont (&optional eol)
+  "Return a number representing the number of unterminated block constructs.
+This is any block, such as if or for, that doesn't have an END on this line.
+Optional EOL indicates a virtual end of line."
+  (let ((v 0))
+    (save-excursion
+      (beginning-of-line)
+      (save-restriction
+	(narrow-to-region (point) (or eol (matlab-point-at-eol)))
+	(matlab-navigation-syntax
+	  (while (re-search-forward (concat "\\<" (matlab-block-beg-re) "\\>")
+				    nil t)
+	    (if (matlab-cursor-in-string-or-comment)
+		;; Do nothing
+		nil
+	      ;; Increment counter, move to end.
+	      (setq v (1+ v))
+	      (let ((p (point)))
+		(forward-word -1)
+		(condition-case nil
+		    (progn
+		      (matlab-forward-sexp)
+		      (setq v (1- v)))
+		  (error (goto-char p))))))
+	  v)))))
+
+(defun matlab-lattr-middle-block-cont ()
+  "Return the number of middle block continuations.
+This should be 1 or nil, and only true if the line starts with one of these
+special items."
+  (save-excursion
+    (back-to-indentation)
+    (if (looking-at (concat (matlab-block-mid-re) "\\>"))
+	(if (and (re-search-forward (matlab-block-end-pre)
+				    (matlab-point-at-eol)
+				    t)
+		 (matlab-valid-end-construct-p))
+	    ;; If there is an END, we still need to return non-nil,
+	    ;; but the number value is a net of 0.
+	    0
+	  1)
+      nil)))
+
+(defun matlab-lattr-endless-block-cont ()
+  "Return the number of middle block continuations.
+This should be 1 or nil, and only true if the line starts with one of these
+special items."
+  (save-excursion
+    (back-to-indentation)
+    (if (looking-at (concat (matlab-endless-blocks-re) "\\>"))
+	1
+      nil)))
+
+(defun matlab-lattr-block-close (&optional start)
+  "Return the number of closing block constructs.
+Argument START is where to start searching from."
+  (let ((v 0))
+    (save-excursion
+      (when start (goto-char start))
+      (save-restriction
+	(narrow-to-region (save-excursion
+			    (matlab-beginning-of-command)
+			    (point))
+			  (matlab-point-at-eol))
+	(goto-char (point-max))
+	(while (and (re-search-backward (concat "\\<" (matlab-block-end-re) "\\>")
+					nil t)
+		    (not (matlab-cursor-in-string-or-comment))
+		    (matlab-valid-end-construct-p))
+	  (setq v (1+ v))
+	  (let ((startmove (match-end 0))
+		(nomove (point)))
+	    (condition-case nil
+		(progn
+		  (matlab-backward-sexp t)
+		  (setq v (1- v)))
+	      (error (goto-char nomove)))
+	    ))
+	;; If we can't scoot back, do a cheat-test to see if there
+	;; is a matching else or elseif.
+	(goto-char (point-min))
+	(back-to-indentation)
+	(if (looking-at (matlab-block-mid-re))
+	    (setq v (1- v)))
+	;; Return nil, or a number
+	(if (<= v 0) nil v)))))
+
+(defun matlab-lattr-local-end ()
+  "Return t if this line begins with an end construct."
+  (save-excursion
+    (back-to-indentation)
+    (and (looking-at (concat "\\<" (matlab-block-end-re) "\\>"))
+         (matlab-valid-end-construct-p))))
+
+(defun matlab-lattr-semantics (&optional prefix)
+  "Return the semantics of the current position.
+Values are nil 'solo, 'value, and 'boolean.  Boolean is a subset of
+value.  nil means there is no semantic content (ie, string or comment.)
+If optional PREFIX, then return 'solo if that is the only thing on the
+line."
+  (cond ;((matlab-cursor-in-string-or-comment)
+	 ;nil)
+	((or (matlab-ltype-empty)
+	     (and prefix (save-excursion
+			   (beginning-of-line)
+			   (looking-at (concat "\\s-*" prefix "\\s-*$")))))
+	 'solo)
+	((save-excursion
+	   (matlab-beginning-of-command)
+	   (looking-at "\\s-*\\(if\\|elseif\\|while\\)\\>"))
+	 'boolean)
+	((save-excursion
+	   (matlab-beginning-of-command)
+	   (looking-at (concat "\\s-*\\(" (matlab-property-function)
+			       "\\)\\>")))
+	 'property)
+	(t
+	 'value)))
+
+(defun matlab-function-called-at-point ()
+  "Return a string representing the function called nearby point."
+  (save-excursion
+    (beginning-of-line)
+    (cond ((looking-at "\\s-*\\([a-zA-Z]\\w+\\)[^=][^=]")
+	   (match-string 1))
+	  ((and (re-search-forward "=" (matlab-point-at-eol) t)
+		(looking-at "\\s-*\\([a-zA-Z]\\w+\\)\\s-*[^=]"))
+	   (match-string 1))
+	  (t nil))))
+
+(defun matlab-cursor-in-string-or-comment ()
+  "Return t if the cursor is in a valid MATLAB comment or string."
+  ;; comment and string depend on each other.  Here is one test
+  ;; that does both.
+  (save-restriction
+    (narrow-to-region (matlab-point-at-bol) (matlab-point-at-eol))
+    (let ((p (1+ (point)))
+	  (returnme nil)
+	  (sregex (concat matlab-string-start-regexp "'")))
+      (save-excursion
+	(goto-char (point-min))
+	(while (and (re-search-forward
+		     (concat "'\\|%\\|" (regexp-quote matlab-elipsis-string))
+		     nil t)
+		    (<= (point) p))
+	  (if (or (= ?% (preceding-char))
+		  (= ?. (preceding-char)))
+	      ;; Here we are in a comment for the rest of it.
+	      (progn
+		(goto-char p)
+		(setq returnme t))
+	    ;; Here, we could be a string start, or transpose...
+	    (if (or (= (current-column) 1)
+		    (save-excursion (forward-char -2)
+				    (looking-at sregex)))
+		;; a valid string start, find the end
+		(let ((f (re-search-forward matlab-string-end-regexp nil t)))
+		  (if f
+		      (setq returnme (> (point) p))
+		    (setq returnme t)))
+	      ;; Ooops, a transpose, keep going.
+	      ))))
+      returnme)))
+
+(defun matlab-cursor-in-comment ()
+  "Return t if the cursor is in a valid MATLAB comment."
+  (save-match-data
+    (save-restriction
+      (narrow-to-region (matlab-point-at-bol) (matlab-point-at-eol))
+      (save-excursion
+	(let ((prev-match nil))
+	  (while (and (re-search-backward
+		       (concat "%\\|" (regexp-quote matlab-elipsis-string) "+")
+		       nil t)
+		      (not (matlab-cursor-in-string)))
+	    (setq prev-match (point)))
+	  (if (and prev-match (matlab-cursor-in-string))
+	      (goto-char prev-match))
+	  (and (looking-at (concat "%\\|"
+				   (regexp-quote matlab-elipsis-string)))
+	       (not (matlab-cursor-in-string))))))))
+
+(defun matlab-cursor-in-string (&optional incomplete)
+  "Return t if the cursor is in a valid MATLAB string.
+If the optional argument INCOMPLETE is non-nil, then return t if we
+are in what could be a an incomplete string."
+  (let ((m (match-data))
+	(returnme nil))
+    (save-restriction
+      (narrow-to-region (matlab-point-at-bol) (matlab-point-at-eol))
+      (let ((p (1+ (point)))
+
+	    (sregex (concat matlab-string-start-regexp "'"))
+	    (instring nil))
+	(save-excursion
+	  ;; Comment hunters need strings to not call the comment
+	  ;; identifiers.  Thus, this routines must be savvy of comments
+	  ;; without recursing to them.
+	  (goto-char (point-min))
+	  (while (or (and instring (looking-at "'"))
+		     (and (re-search-forward
+			   (concat "'\\|%\\|"
+				   (regexp-quote matlab-elipsis-string))
+			   nil t)
+			  (<= (point) p)
+			  ;; Short circuit to fix this.
+			  (progn (setq instring nil) t)))
+	    ;; The next line emulates re-search-foward
+	    (if instring (goto-char (match-end 0)))
+	    (if (or (= ?% (preceding-char))
+		    (= ?. (preceding-char)))
+		;; Here we are in a comment for the rest of it.
+		;; thus returnme is a force-false.
+		(goto-char p)
+	      ;; Here, we could be in a string start, or transpose...
+	      (if (or (= (current-column) 1)
+		      instring
+		      (save-excursion (forward-char -2)
+				      (looking-at sregex)))
+		  ;; a valid string start, find the end
+		  (let ((f (re-search-forward matlab-string-end-regexp nil t)))
+		    (if (and (not f) incomplete)
+			(setq returnme t)
+		      (setq returnme (> (point) p))
+		      (setq instring t)))
+		;; Ooops, a transpose, keep going.
+		))))))
+    (set-match-data m)
+    returnme))
+  
+
+(defun matlab-comment-on-line ()
+  "Place the cursor on the beginning of a valid comment on this line.
+If there isn't one, then return nil, point otherwise."
+  (interactive)
+  (let ((eol (matlab-point-at-eol))
+	(p (point))
+	(signal-error-on-buffer-boundary nil))
+    (beginning-of-line)
+    (while (and (re-search-forward "%" eol t)
+		(save-excursion (forward-char -1) (matlab-cursor-in-string t))))
+    (if (not (bolp)) (forward-char -1))
+    (if (and (looking-at "%") (not (matlab-cursor-in-string t)))
+	(point)
+      (goto-char p)
+      nil)))
+
+;;; Indent functions ==========================================================
+
+(defun matlab-indent-line ()
+  "Indent a line in `matlab-mode'."
+  (interactive)
+  (let ((i (matlab-calc-indent))
+	(c (current-column)))
+    (save-excursion
+      (back-to-indentation)
+      (if (= i (current-column))
+	  nil
+	(beginning-of-line)
+	(delete-horizontal-space)
+	(indent-to i))
+      ;; If line contains a comment, format it.
+      (if () (if (matlab-lattr-comm) (matlab-comment))))
+    (if (<= c i) (move-to-column i))))
+
+(defun matlab-calc-indent ()
+  "Return the appropriate indentation for this line as an integer."
+  (interactive)
+  ;; The first step is to find the current indentation.
+  ;; This is defined to be zero if all previous lines are empty.
+  (let* ((ci (save-excursion (if (not (matlab-prev-line))
+                                 0
+                               (matlab-next-line-indentation))))
+         (sem (matlab-calculate-indentation ci)))
+    ;; simplistic
+    (nth 1 sem)))
+
+(defconst matlab-functions-have-end-should-be-true
+  "This end closes a function definition.\nDo you want functions to have ends? "
+  "Prompt the user about whether to change matlab-functions-have-end")
+
+(defun matlab-calculate-indentation (current-indentation)
+  "Calculate out the indentation of the current line.
+Return a list of descriptions for this line.  Return format is:
+ '(TYPE DEPTHNUMBER)
+where TYPE is one of (comment, code, function, blockstart, blockmid,
+blockendless, blockend) DEPTHNUMBER is how many characters to indent
+this line.
+  Argument CURRENT-INDENTATION is what the previous line thinks
+this line's indentation should be.  See `matlab-next-line-indentation'."
+  (matlab-navigation-syntax
+    (matlab-calculate-indentation-1 current-indentation)))
+
+(defun matlab-calculate-indentation-1 (current-indentation)
+  "Do the indentation work of `matlab-calculate-indentation'.
+Argument CURRENT-INDENTATION is what the previous line recommends for indentation."
+  (let ((ci current-indentation)
+	(tmp nil))
+    (cond
+     ;; COMMENTS
+     ((matlab-ltype-comm)
+      (cond
+       ;; HELP COMMENT and COMMENT REGION
+       ((or (matlab-ltype-help-comm)
+	    (matlab-ltype-comm-ignore))
+	(list 'comment-help
+	      (save-excursion
+		(matlab-beginning-of-defun)
+		(current-indentation))))
+       ;; COMMENT Continued From Previous Line
+       ((setq tmp (matlab-ltype-continued-comm))
+	(list 'comment tmp))
+       ;; END FUNCTION COMMENT
+       ((matlab-ltype-endfunction-comm)
+	(list 'comment-endfunction 0))
+       (t
+	(list 'comment (+ ci matlab-comment-anti-indent)))))
+     ;; FUNCTION DEFINITION
+     ((matlab-ltype-function-definition)
+      (if matlab-functions-have-end
+          ;; A function line has intrinsic indentation iff function bodies are
+          ;; not indented and the function line is nested within another function.
+          (if (and (not (matlab-indent-function-body-p))
+                   (save-excursion
+                     (beginning-of-line)
+                     (matlab-beginning-of-enclosing-defun)))
+              (setq ci (+ ci matlab-indent-level))
+            ;; If no intrinsic indentation, do not change from ci.
+            )
+        ;; If functions are not nested, functions go to left margin.
+        (setq ci 0))
+      (list 'function ci))
+     ;; END keyword
+     ((matlab-lattr-local-end)
+      (let ((end-of-function
+             (let ((matlab-functions-have-end t))
+               (save-excursion
+                 (beginning-of-line)
+                 (matlab-backward-sexp t) ;; may throw "unstarted block" error
+                 (matlab-ltype-function-definition)))))
+        (if end-of-function
+            (if (or matlab-functions-have-end
+                    (if (yes-or-no-p matlab-functions-have-end-should-be-true)
+			;; TODO - ask user to reindent the fcn now?
+                        (setq matlab-functions-have-end t)
+                      (error "Unmatched end")))
+                (if (matlab-indent-function-body-p)
+                    (setq ci (- ci matlab-indent-level))))
+          ;; Next, see if this line starts with an end, and whether the
+          ;; end is matched, and whether the line is blank up to the match.
+          ;; If so, return the indentation of the match.
+          (catch 'indent
+            (save-excursion
+              (when (progn (beginning-of-line)
+                           (and (looking-at "[ \t]*end\\b")
+                                (matlab-backward-sexp t t)))
+                (let ((match (point)))
+                  (beginning-of-line)
+                  (looking-at "[ \t]*")
+                  (when (= match (match-end 0))
+                    (setq ci (- match (match-beginning 0)))
+                    (throw 'indent nil)))))
+            ;; End of special case for end and match after "^[ \t]*".
+            (setq ci (+ ci
+                        (* (1- (matlab-lattr-block-cont (point)))
+                           matlab-indent-level))))))
+      (list 'blockend ci))
+     ;; ELSE/CATCH keywords
+     ((matlab-lattr-middle-block-cont)
+      (let ((m (match-string 1)))
+	(list 'blockmid
+	      (condition-case nil
+		  (save-excursion
+		    (beginning-of-line)
+		    (matlab-backward-sexp t)
+		    (if (matlab-ltype-function-definition) (error ""))
+		    (current-column))
+		(error (error "Unmatched %s" m))))))
+     ;; CASE/OTHERWISE keywords
+     ((matlab-lattr-endless-block-cont)
+      (list 'blockendless
+	    (condition-case nil
+		(save-excursion
+		  (beginning-of-line)
+		  (matlab-backward-sexp t)
+		  (if (not (looking-at "switch\\>")) (error ""))
+		  (+ (current-column)
+		     (if (listp matlab-case-level)
+			 (car matlab-case-level)
+		       matlab-case-level)))
+	      (error (error "Unmatched case/otherwise part")))))
+     ;; End of a MATRIX
+     ((matlab-lattr-array-end)
+      (list 'array-end (save-excursion
+			(back-to-indentation)
+			(matlab-up-list -1)
+			(let* ((fc (following-char))
+			       (mi (assoc fc matlab-maximum-indents))
+			       (max (if mi (if (listp (cdr mi))
+					       (car (cdr mi)) (cdr mi))
+				      nil))
+			       (ind (if mi (if (listp (cdr mi))
+					       (cdr (cdr mi)) (cdr mi))
+				      nil)))
+			  ;; apply the maximum limits.
+			  (if (and ind (> (- (current-column) ci) max))
+			      (1- ind) ; decor
+			    (current-column))))))
+     ;; Code lines
+     ((save-excursion
+	(beginning-of-line)
+	(back-to-indentation)
+	(= (point) (progn (matlab-beginning-of-command) (point))))
+      ;; This means we are at the beginning of a command structure.
+      ;; Always match up against the previous line.
+      (list 'code ci))
+     ;; Lines continued from previous statements.
+     (t
+      (list (if (matlab-ltype-empty) 'empty
+	      (if (matlab-lattr-array-cont) 'array-cont 'code))
+	    (condition-case nil
+		;; Line up with opening paren/brace/bracket
+		(let ((boc (save-excursion
+			     (matlab-beginning-of-command)
+			     (point))))
+		  (save-excursion
+		    (beginning-of-line)
+		    (matlab-up-list -1)
+		    (if (> boc (point)) (error nil))
+		    ;; Ok, it MIGHT be that we are in a program
+		    ;; statement, and this particular command is an HG
+		    ;; statement that would look better if the
+		    ;; following lines lined up AFTER the first
+		    ;; argument.  Lets look.
+		    (let ((parendepth (current-column)))
+		      (cond ((and (= (following-char) ?\( )
+				  (save-excursion
+				    (matlab-navigation-syntax
+				      (forward-word -1)
+				      (looking-at
+				       matlab-indent-past-arg1-functions)))
+				  (let ((start-paren (point)))
+				    (while
+					(and
+					 (re-search-forward
+					  "," (matlab-point-at-eol) t)
+					 (save-excursion
+					   (matlab-up-list -1)
+					   (> (point) start-paren))))
+				    (if (and
+					 (= (preceding-char) ?,)
+					 ;; Don't bother if we hit the EOL.
+					 (not (looking-at
+
+					       "\\s-*\\(\\.\\.\\.\\|$\\|)\\)")))
+					t
+				      (move-to-column parendepth)
+				      nil)))
+			     (skip-chars-forward " \t")
+			     (if (> (- (current-column) parendepth)
+				    matlab-arg1-max-indent-length)
+				 (+ parendepth matlab-arg1-max-indent-length)
+			       (current-column)))
+			    (t
+			     (let* ((fc (following-char))
+				    (mi (assoc fc matlab-maximum-indents))
+				    (max (if mi
+					     (if (listp (cdr mi))
+						 (car (cdr mi)) (cdr mi))
+					   nil))
+				    (ind (if mi
+					     (if (listp (cdr mi))
+						 (cdr (cdr mi)) (cdr mi))
+					   nil)))
+			       (forward-char 1)
+			       (skip-chars-forward " \t")
+			       ;; If we are at the end of a line and
+			       ;; this open paren is there, then we
+			       ;; DONT want to indent to it.  Use the
+			       ;; standard indent.
+			       (if (looking-at "\\.\\.\\.\\|$")
+				   ;; This could happen in another set
+				   ;; of matricies.  Find a current
+				   ;; indentation based on the
+				   ;; previous line.
+				   (let ((cci (current-indentation)))
+				     (+ cci matlab-cont-level))
+				 ;; apply the maximum limits.
+				 (if (and ind (> (- (current-column) ci) max))
+				     (+ ci ind)
+				   (current-column)))))))))
+	      (error
+	       ;; Line up to an equals sign.
+	       (save-excursion
+		 (matlab-beginning-of-command)
+		 (while (and (re-search-forward "=" (matlab-point-at-eol) t)
+			     (matlab-cursor-in-string-or-comment)))
+		 (if (/= (preceding-char) ?=)
+		     (+ ci matlab-cont-level)
+		   (skip-chars-forward " \t")
+		   (let ((cc (current-column))
+			 (mi (assoc ?= matlab-maximum-indents)))
+		     (if (looking-at "\\.\\.\\.\\|$")
+			 ;; In this case, the user obviously wants the
+			 ;; indentation to be somewhere else.
+			 (+ ci (cdr (cdr mi)))
+		       ;; If the indent delta is greater than the max,
+		       ;; use the max + currenti
+		       (if (and mi (> (- cc ci) (if (listp (cdr mi))
+						    (car (cdr mi))
+						  (cdr mi))))
+			   (setq cc (+ ci (if (listp (cdr mi))
+					      (cdr (cdr mi))
+					    (cdr mi)))))
+		       cc))))))))
+     )))
+
+(defun matlab-next-line-indentation ()
+  "Calculate the indentation for lines following this command line.
+Assume that the following line does not contribute its own indentation
+\(as it does in the case of nested functions in the following situations):
+  o function---positive indentation when not indenting function bodies.
+  o end---negative indentation except when the 'end' matches a function and
+    not indenting function bodies.
+See `matlab-calculate-indentation'."
+  (matlab-navigation-syntax
+    (let ((startpnt (point-at-eol)))
+      (save-excursion
+	(matlab-beginning-of-command)
+	(let ((cc (or (matlab-lattr-block-close startpnt) 0))
+	      (end (matlab-lattr-local-end))
+	      (bc (matlab-lattr-block-cont startpnt))
+	      (mc (matlab-lattr-middle-block-cont))
+	      (ec (matlab-lattr-endless-block-cont))
+	      (hc (and (matlab-indent-function-body-p) (matlab-ltype-help-comm)))
+	      (rc (and (/= 0 matlab-comment-anti-indent)
+		       (matlab-ltype-comm)
+		       (not (matlab-ltype-help-comm))
+		       (not (matlab-ltype-continued-comm))
+		       (not (matlab-ltype-endfunction-comm))))
+	      (ci (current-indentation)))
+	  ;; When the current point is on a line with a function, the value of bc will
+	  ;; reflect the function in a block count iff if matlab-functions-have-end is
+	  ;; true.  However, if matlab-indent-function-body-p is false, there should be
+	  ;; no actual indentation, so bc needs to be decremented by 1.  Similarly, if
+	  ;; on a line with an end that closes a function, bc needs to be decremented
+	  ;; by 1 if matlab-functions-have-end is true and matlab-indent-function-body-p
+	  ;; is false.  However, just to be safe, indentation is not allowed to go
+	  ;; negative.  Thus:
+	  (if matlab-functions-have-end
+	      (if (and
+		   (not (matlab-indent-function-body-p))
+		   (or (matlab-ltype-function-definition)
+		       (and (matlab-lattr-local-end)
+			    (save-excursion
+			      (matlab-backward-sexp t)
+			      (looking-at "function\\b")))))
+		  (if (> bc 0)
+		      (setq bc (1- bc))
+		    (if (>= ci matlab-indent-level)
+			(setq bc -1))))
+	    (if (and (matlab-indent-function-body-p) (matlab-ltype-function-definition))
+		(setq bc (1+ bc))))
+	  ;; Remove 1 from the close count if there is an END on the beginning
+	  ;; of this line, since in that case, the unindent has already happened.
+	  (when end (setq cc (1- cc)))
+	  ;; Calculate the suggested indentation.
+	  (+ ci
+	     (* matlab-indent-level bc)
+	     (* matlab-indent-level (or mc 0))
+	     (* matlab-indent-level (- cc))
+	     (* (if (listp matlab-case-level)
+		    (cdr matlab-case-level) matlab-case-level)
+		(or ec 0))
+	     (if hc matlab-indent-level 0)
+	     (if rc (- 0 matlab-comment-anti-indent) 0)
+	     ))))))
+
+;;; The return key ============================================================
+
+(defcustom matlab-return-function 'matlab-indent-end-before-ret
+  "Function to handle return key.
+Must be one of:
+    'matlab-plain-ret
+    'matlab-indent-after-ret
+    'matlab-indent-end-before-ret
+    'matlab-indent-before-ret"
+  :group 'matlab
+  :type '(choice (function-item matlab-plain-ret)
+		 (function-item matlab-indent-after-ret)
+		 (function-item matlab-indent-end-before-ret)
+		 (function-item matlab-indent-before-ret)))
+
+(defun matlab-return ()
+  "Handle carriage return in `matlab-mode'."
+  (interactive)
+  (matlab-semicolon-on-return)
+  (funcall matlab-return-function))
+
+(defun matlab-plain-ret ()
+  "Vanilla new line."
+  (interactive)
+  (newline))
+  
+(defun matlab-indent-after-ret ()
+  "Indent after new line."
+  (interactive)
+  (newline)
+  (matlab-indent-line))
+
+(defun matlab-indent-end-before-ret ()
+  "Indent line if block end, start new line, and indent again."
+  (interactive)
+  (if (save-excursion
+	(beginning-of-line)
+	(looking-at (concat "^\\s-*\\(" (matlab-block-end-re)
+			    "\\|" (matlab-block-mid-re)
+			    "\\|" (matlab-endless-blocks-re)
+			    "\\|function\\)")))
+      (matlab-indent-line))
+  (newline)
+  (matlab-indent-line))
+
+(defun matlab-semicolon-on-return ()
+  "If needed, add a semicolon at point automatically."
+  (if matlab-return-add-semicolon
+      (if (and (not (matlab-ltype-empty))
+	       (not (save-excursion
+		      (skip-chars-backward " \t;" (matlab-point-at-bol))
+		      (looking-at "\\s-*;")))
+	       (save-excursion
+		 (let ((p (point)))
+		   (matlab-end-of-command (point))
+		   (eq p (point))))
+	       (save-excursion
+		 (matlab-beginning-of-command)
+		 ;; Note: Compile warning below, but defined later.
+		 (not (looking-at matlab-quiesce-nosemi-regexp))))
+	  (insert ";"))
+    ))
+
+(defun matlab-indent-before-ret ()
+  "Indent line, start new line, and indent again."
+  (interactive)
+  (matlab-indent-line)
+  (newline)
+  (matlab-indent-line))
+
+(defun matlab-linefeed ()
+  "Handle line feed in `matlab-mode'.
+Has effect of `matlab-return' with (not matlab-indent-before-return)."
+  (interactive)
+  (matlab-indent-line)
+  (newline)
+  (matlab-indent-line))
+
+(defun matlab-comment-return ()
+  "Handle carriage return for MATLAB comment line."
+  (interactive)
+  (cond
+   ((matlab-ltype-comm)
+    (matlab-set-comm-fill-prefix) (newline) (insert fill-prefix)
+    (matlab-reset-fill-prefix) (matlab-indent-line))
+   ((matlab-lattr-comm)
+    (newline) (indent-to comment-column)
+    (insert matlab-comment-on-line-s))
+   (t
+    (newline) (matlab-comment) (matlab-indent-line))))
+
+(defun matlab-comm-from-prev ()
+  "If the previous line is a comment-line then set up a comment on this line."
+  (save-excursion
+    ;; If the previous line is a comment-line then set the fill prefix from
+    ;; the previous line and fill this line.
+    (if (and (= 0 (forward-line -1)) (matlab-ltype-comm))
+	(progn
+	  (matlab-set-comm-fill-prefix)
+	  (forward-line 1) (beginning-of-line)
+	  (delete-horizontal-space)
+	  (if (looking-at "%") (delete-char 1))
+	  (delete-horizontal-space)
+	  (insert fill-prefix)
+	  (matlab-reset-fill-prefix)))))
+
+(defun matlab-electric-comment (arg)
+  "Indent line and insert comment character.
+Argument ARG specifies how many %s to insert."
+  (interactive "P")
+  (self-insert-command (or arg 1))
+  (when (matlab-ltype-comm)
+    (matlab-indent-line)
+    ;; The above seems to put the cursor on the %, not after it.
+    (skip-chars-forward "%")))
+
+
+;;; Comment management========================================================
+
+(defun matlab-comment ()
+  "Add a comment to the current line."
+  (interactive)
+  (cond ((matlab-ltype-empty)		; empty line
+	 (matlab-comm-from-prev)
+	 (if (matlab-lattr-comm)
+	     (skip-chars-forward " \t%")
+	   (insert matlab-comment-line-s)
+	   (matlab-indent-line)))
+	((matlab-ltype-comm)		; comment line
+	 (matlab-comm-from-prev)
+	 (skip-chars-forward " \t%"))
+	((matlab-lattr-comm)		; code line w/ comment
+	 (beginning-of-line)
+	 (re-search-forward "[^%]%[ \t]")
+	 (forward-char -2)
+	 (if (> (current-column) comment-column) (delete-horizontal-space))
+	 (if (< (current-column) comment-column) (indent-to comment-column))
+	 (skip-chars-forward "% \t"))
+	(t				; code line w/o comment
+	 (end-of-line)
+	 (re-search-backward "[^ \t\n^]" 0 t)
+	 (forward-char)
+	 (delete-horizontal-space)
+	 (if (< (current-column) comment-column)
+	     (indent-to comment-column)
+	   (insert " "))
+	 (insert matlab-comment-on-line-s))))
+
+(defun matlab-comment-line-break-function (&optional soft)
+  "Break the current line, and if in a comment, continue it.
+Optional argument SOFT indicates that the newline is soft, and not hard."
+  (interactive)
+  (if (not (matlab-cursor-in-comment))
+      (matlab-return)
+    ;; Will the below fn work in old emacsen?
+    (if soft (insert-and-inherit ?\n) (newline 1))
+    (insert "% ")
+    (matlab-indent-line)
+    (end-of-line)))
+
+(defun matlab-comment-indent ()
+  "Indent a comment line in `matlab-mode'."
+  (matlab-calc-indent))
+
+(defun matlab-comment-region (beg-region end-region arg)
+  "Comments every line in the region.
+Puts `matlab-comment-region-s' at the beginning of every line in the region.
+BEG-REGION and END-REGION are arguments which specify the region boundaries.
+With non-nil ARG, uncomments the region."
+  (interactive "*r\nP")
+  (let ((end-region-mark (make-marker)) (save-point (point-marker)))
+    (set-marker end-region-mark end-region)
+    (goto-char beg-region)
+    (beginning-of-line)
+    (if (not arg)			;comment the region
+	(progn (insert matlab-comment-region-s)
+	       (while (and  (= (forward-line 1) 0)
+			    (< (point) end-region-mark))
+		 (insert matlab-comment-region-s)))
+      (let ((com (regexp-quote matlab-comment-region-s))) ;uncomment the region
+	(if (looking-at com)
+	    (delete-region (point) (match-end 0)))
+	(while (and  (= (forward-line 1) 0)
+		     (< (point) end-region-mark))
+	  (if (looking-at com)
+	      (delete-region (point) (match-end 0))))))
+    (goto-char save-point)
+    (set-marker end-region-mark nil)
+    (set-marker save-point nil)))
+
+(defun matlab-uncomment-region (beg end)
+  "Uncomment the current region if it is commented out.
+Argument BEG and END indicate the region to uncomment."
+  (interactive "*r")
+  (matlab-comment-region beg end t))
+
+;;; Filling ===================================================================
+
+(defun matlab-set-comm-fill-prefix ()
+  "Set the `fill-prefix' for the current (comment) line."
+  (interactive)
+  (if (matlab-lattr-comm)
+      (setq fill-prefix
+	    (save-excursion
+	      (beginning-of-line)
+	      (let ((e (matlab-point-at-eol))
+		    (pf nil))
+		(while (and (re-search-forward "%+[ \t]*\\($$$ \\)?" e t)
+			    (matlab-cursor-in-string)))
+		(setq pf (match-string 0))
+		(concat (make-string (- (current-column) (length pf)) ? )
+			pf))))))
+
+(defun matlab-set-comm-fill-prefix-post-code ()
+  "Set the `fill-prefix' for the current post-code comment line."
+  (interactive)
+  (matlab-set-comm-fill-prefix))
+
+(defun matlab-reset-fill-prefix ()
+  "Reset the `fill-prefix'."
+  (setq fill-prefix nil))
+
+(defun matlab-find-convenient-line-break ()
+  "For the current line, position the cursor where we want to break the line.
+Basically, spaces are best, then operators.  Always less than `fill-column'
+unless we decide we can fudge the numbers.  Return nil if this line should
+not be broken.  This function will ONLY work on code."
+  ;; First of all, if this is a continuation, then the user is
+  ;; requesting that we don't mess with his stuff.
+  (if (matlab-lattr-cont)
+      nil
+    (save-restriction
+      (narrow-to-region (matlab-point-at-bol) (matlab-point-at-eol))
+      ;; get ourselves onto the fill-column.
+      (move-to-column fill-column)
+      (let ((pos nil)
+	    (orig (point)))
+	(or
+	 ;; Next, if we have a trailing comment, use that.
+	 (progn (setq pos (or (matlab-lattr-comm) (matlab-point-at-bol)))
+		(goto-char pos)
+		(if (and (> (current-column) (- fill-column matlab-fill-fudge))
+			 (< (current-column) (+ fill-column matlab-fill-fudge)))
+		    t
+		  (goto-char orig)
+		  nil))
+	 ;; Now, lets find the nearest space (after or before fill column)
+	 (let* ((after (save-excursion
+			 (re-search-forward "[ \t]" nil t)))
+		(before (save-excursion
+			  (re-search-backward "[ \t]" nil t)))
+		(afterd (- (or after (matlab-point-at-eol)) (point)))
+		(befored (- (point) (or before (matlab-point-at-bol)))))
+	   ;; Here, if "before" is actually the beginning of our
+	   ;; indentation, then this is most obiously a bad place to
+	   ;; break our lines.
+	   (if before
+	       (save-excursion
+		 (goto-char before)
+		 (if (<= (point) (save-excursion
+				   (back-to-indentation)
+				   (point)))
+		     (setq before nil))))
+	   (cond ((and after
+		       (< afterd matlab-fill-fudge)
+		       (< afterd befored))
+		  (goto-char after)
+		  t)
+		 ((and before
+		       (< befored matlab-fill-fudge)
+		       (< befored afterd))
+		  (goto-char before)
+		  t)
+		 (t (goto-char orig)
+		    nil)))
+	 ;; Now, lets find the nearest backwards
+	 (progn
+	   (re-search-backward "\\(\\s-\\|\\s.\\)+" nil t)
+	   (while (and (looking-at "\\^\\|\\.\\|'")
+		       (re-search-backward "\\(\\s-\\|\\s.\\)+" nil t)))
+	   (if (or (not (looking-at "\\(\\s-\\|\\s.\\)+"))
+		   (<= (point) (save-excursion
+				 (back-to-indentation)
+				 (point))))
+	       (progn
+		 ;; We failed in our mission to find anything, or fell
+		 ;; of the edge of the earth.  If we are out of
+		 ;; bounds, lets try again.
+		 (goto-char orig)
+		 (if (re-search-backward "\\s.+" nil t)
+		     t
+		   nil))
+	     ;; Ok, we have a good location to break.  Check for column
+	     ;; and ref against nearest list ending to predict a possibly
+	     ;; better break point.
+	     (forward-char 1)
+	     (let ((okpos (current-column))
+		   (startlst (save-excursion
+			       (condition-case nil
+				   (matlab-up-list -1)
+				 (error nil))
+			       (if (save-excursion
+				     (forward-char -1)
+				     (looking-at "\\w"))
+				   (forward-word -1))
+			       (current-column)))
+		   (endlst (save-excursion
+			     (condition-case nil
+				 (matlab-up-list 1)
+			       (error nil))
+			     (current-column))))
+	       ;; When evaluating list fudge factores, breaking on the
+	       ;; edge of a list, or at the beginning of a function
+	       ;; call can be more valuable than breaking on a symbol
+	       ;; of a mid-sized list.  As such, allow double-fudge
+	       ;; for lists.
+	       (cond
+		;; First, pick the end of a list.
+		((and (< endlst matlab-fill-fudge-hard-maximum)
+		      (<= endlst (+ fill-column matlab-fill-fudge))
+		      (or (<= (* matlab-fill-fudge 2) (- endlst okpos))
+			  (<= endlst fill-column))
+		      (save-excursion
+			(move-to-column endlst)
+			(not (looking-at "\\^"))))
+		 (move-to-column endlst)
+		 t)
+		;; Else, back up over this list and poke around
+		((>= (* 2 matlab-fill-fudge) (- okpos startlst))
+		 (move-to-column startlst)
+		 t)
+		;; Oh well, just do this symbol.
+		(t (move-to-column okpos)
+		   t)))))
+	 ;; Well, this just sucks
+	 (progn (goto-char orig)
+		nil))))))
+
+(defun matlab-auto-fill ()
+  "Do auto filling.
+Set variable `auto-fill-function' to this symbol to enable MATLAB style auto
+filling which will automatically insert `...' and the end of a line."
+  (interactive)
+  (let ((fill-prefix fill-prefix) ;; safe way of modifying fill-prefix.
+	(fill-column (- fill-column
+			(if matlab-fill-count-ellipsis-flag
+			    (save-excursion
+			      (move-to-column fill-column)
+			      (if (not (bobp))
+				  (forward-char -1))
+			      (if (matlab-cursor-in-string 'incomplete)
+				  4 3))
+			  0))))
+    (if (> (current-column) fill-column)
+	(cond
+	 ((matlab-ltype-comm-ignore)
+	  nil)
+	 ((or (matlab-ltype-comm)
+	      (and (save-excursion (move-to-column fill-column)
+				   (matlab-cursor-in-comment))
+		   (matlab-lattr-comm)))
+	  ;; If the whole line is a comment, do this.
+	  (matlab-set-comm-fill-prefix) (do-auto-fill)
+	  (matlab-reset-fill-prefix))
+	 ((and (matlab-ltype-code)
+	       (not (matlab-lattr-cont))
+	       matlab-fill-code)
+	  ;; If we are on a code line, we ellipsify before we fill.
+	  (let ((m (make-marker)))
+	    (move-marker m (point))
+	    (set-marker-insertion-type m t)
+	    (if (not (matlab-find-convenient-line-break))
+		nil
+	      (if (not (save-excursion
+			 (forward-char -1)
+			 (matlab-cursor-in-string 'incomplete)))
+		  (progn
+		    (delete-horizontal-space)
+		    (insert " " matlab-elipsis-string "\n")
+		    (matlab-indent-line))
+		(if matlab-fill-strings-flag
+		    (let ((pos (point))
+			  (pos2 nil))
+		      (while (and (re-search-backward "'" (point-at-bol) t)
+				  (progn (forward-char -1)
+					 (looking-at "''"))))
+		      (setq pos2 (point))
+		      ;; Check if there is already an opening bracket or if string is continued
+		      (if (or (looking-at "\\[")
+			      (save-excursion (skip-chars-backward " \t")
+				     (forward-char -1)
+				     (looking-at "\\["))
+			      (progn
+				(beginning-of-line)
+				     (skip-chars-backward (concat " \t\n" matlab-elipsis-string))
+				     (if (> (point) (point-min))
+					 (progn
+					   (forward-char -1)
+					   (looking-at (concat "'\\s-*" matlab-elipsis-string))))))
+			  (goto-char pos)
+			(goto-char pos2)
+			(forward-char 1)
+			(insert "[")
+			(goto-char pos)
+			(forward-char 1))
+		      ;(delete-horizontal-space)
+		      (skip-chars-forward " \t")
+		      (insert "' " matlab-elipsis-string "\n")
+		      (matlab-indent-line)
+		      (insert "'")
+			;; Re scan forward for the end of the string. Add an end bracket
+			;; if there isn't one already. Also add an apostrophe if necessary.
+		      (if (not (looking-at "'\\s-*]"))
+			  (save-excursion
+			    (if (not (re-search-forward "[^']'[^']" (line-end-position) t))
+				(progn
+				  (end-of-line)
+				  (insert "']")
+				  (move-marker m (- (point) 2)))
+			      (forward-char -2)
+			      (if (not (looking-at "'\\s-*]"))
+				  (progn
+				    (forward-char 1)
+				    (insert "]"))))))
+		  ))))
+	  (goto-char m)))
+      ))))
+
+(defun matlab-join-comment-lines ()
+  "Join current comment line to the next comment line."
+  ;; New w/ V2.0: This used to join the previous line, but I could find
+  ;; no editors that had a "join" that did that.  I modified join to have
+  ;; a behaviour I thought more inline with other editors.
+  (interactive)
+  (end-of-line)
+  (if (looking-at "\n[ \t]*%")
+      (replace-match " " t t nil)
+    (error "No following comment to join with")))
+
+(defun matlab-fill-region (beg-region end-region &optional justify-flag)
+  "Fill the region between BEG-REGION and END-REGION.
+Non-nil JUSTIFY-FLAG means justify comment lines as well."
+  (interactive "*r\nP")
+  (let ((end-reg-mk (make-marker)))
+    (set-marker end-reg-mk end-region)
+    (goto-char beg-region)
+    (beginning-of-line)
+    (while (< (point) end-reg-mk)
+      ;; This function must also leave the point at the end of the
+      ;; justified line.
+      (matlab-fill-paragraph justify-flag)
+      (forward-line 1)
+      (beginning-of-line))))
+
+(defun matlab-fill-comment-line (&optional justify)
+  "Fill the current comment line.
+With optional argument, JUSTIFY the comment as well."
+  (interactive)
+  (if (not (matlab-comment-on-line))
+      (error "No comment to fill"))
+  (beginning-of-line)
+  ;; First, find the beginning of this comment...
+  (while (and (looking-at matlab-cline-start-skip)
+	      (not (bobp)))
+    (forward-line -1)
+    (beginning-of-line))
+  (if (not (looking-at matlab-cline-start-skip))
+      (forward-line 1))
+  ;; Now scan to the end of this comment so we have our outer bounds,
+  ;; and narrow to that region.
+  (save-restriction
+    (narrow-to-region (point)
+		      (save-excursion
+			(while (and (looking-at matlab-cline-start-skip)
+				    (not (save-excursion (end-of-line) (eobp))))
+			  (forward-line 1)
+			  (beginning-of-line))
+			(if (not (looking-at matlab-cline-start-skip))
+			    (forward-line -1))
+			(end-of-line)
+			(point)))
+    ;; Find the fill prefix...
+    (matlab-comment-on-line)
+    (looking-at "%[ \t]*")
+    (let ((fill-prefix (concat (make-string (current-column) ? )
+			       (match-string 0))))
+      (fill-region (point-min) (point-max) justify))))
+
+(defun matlab-justify-line ()
+  "Delete space on end of line and justify."
+  (interactive)
+  (save-excursion
+    (end-of-line)
+    (delete-horizontal-space)
+    (justify-current-line)))
+
+(defun matlab-fill-paragraph (arg)
+  "When in a comment, fill the current paragraph.
+Paragraphs are always assumed to be in a comment.
+ARG is passed to `fill-paragraph' and will justify the text."
+  (interactive "P")
+  (cond ((or (matlab-ltype-comm)
+	     (and (matlab-cursor-in-comment)
+		  (not (matlab-lattr-cont))))
+	 ;; We are in a comment, lets fill the paragraph with some
+	 ;; nice regular expressions.
+	 ;; Cell start/end markers of %% also separate paragraphs
+	 (let ((paragraph-separate "%%\\|%[a-zA-Z]\\|%[ \t]*$\\|[ \t]*$")
+	       (paragraph-start "%[a-zA-Z]\\|%[ \t]*$\\|[ \t]*$")
+	       (paragraph-ignore-fill-prefix nil)
+	       (start (save-excursion (matlab-beginning-of-command)
+				      (if (looking-at "%%")
+					  (progn (end-of-line)
+						 (forward-char 1)))
+				      (point)))
+	       (end (save-excursion (matlab-end-of-command)
+				    (point)))
+	       (fill-prefix nil))
+	   (matlab-set-comm-fill-prefix)
+	   (save-restriction
+	     ;; Ben North fixed to handle comment at the end of
+	     ;; a buffer.
+	     (narrow-to-region start (min (point-max) (+ end 1)))
+	     (fill-paragraph arg))))
+	((matlab-ltype-code)
+	 ;; Ok, lets get the outer bounds of this command, then
+	 ;; completely refill it using the smart line breaking code.
+	 (save-restriction
+	   (narrow-to-region (save-excursion
+			       (matlab-beginning-of-command)
+			       (beginning-of-line)
+			       (point))
+			     (save-excursion
+			       (matlab-end-of-command)
+			       (point)))
+	   ;; Remove all line breaks
+	   (goto-char (point-min))
+	   (while (and (re-search-forward "$" nil t)
+		       (not (eobp)))
+	     (delete-horizontal-space)
+	     ;; Blow away continuation marks
+	     (if (matlab-lattr-cont)
+		 (progn
+		   (goto-char (match-beginning 0))
+		   (forward-char 1)
+		   (delete-region (point) (matlab-point-at-eol))))
+	     ;; Zap the CR
+	     (if (not (eobp)) (delete-char 1))
+	     ;; Clean up whitespace
+	     (delete-horizontal-space)
+	     ;; Clean up trailing comments
+	     (if (and (looking-at "% *")
+		      (matlab-cursor-in-comment))
+		 (progn
+		   (delete-char 1)
+		   (delete-horizontal-space)))
+	     (insert " "))
+	   ;; Now fill till we are done
+	   (goto-char (point-max))
+	   (while (or (> (current-column) (+ fill-column matlab-fill-fudge))
+		      (> (current-column) matlab-fill-fudge-hard-maximum))
+	     (if (= (point)
+		    (progn
+		      (matlab-auto-fill)
+		      (point)))
+		 (error "Fill algorith failed!"))
+	     (if arg (save-excursion
+		       (forward-line -1)
+		       (matlab-justify-line))))
+	   (if arg (save-excursion
+		     (forward-line -1)
+		     (matlab-justify-line)))))
+	(t
+	 (message "Paragraph Fill not supported in this context."))))
+
+;;; Semantic text insertion and management ====================================
+
+(defun matlab-find-recent-variable-list (prefix)
+  "Return a list of most recent variables starting with PREFIX as a string.
+Reverse searches for the following are done first:
+  1) Assignment
+  2) if|for|while|switch 
+  3) global variables
+  4) function arguments.
+All elements are saved in a list, which is then uniqafied.
+If NEXT is non-nil, then the next element from the saved list is used.
+If the list is empty, then searches continue backwards through the code."
+  (matlab-navigation-syntax
+    (let* ((bounds (save-excursion
+		     (if (re-search-backward "^\\s-*function\\>" nil t)
+			 (match-beginning 0) (point-min))))
+	   (syms
+	    (append
+	     (save-excursion
+	       (let ((lst nil))
+		 (while (and
+			 (re-search-backward
+			  (concat "^\\s-*\\(" prefix "\\w+\\)\\s-*=")
+			  bounds t)
+			 (< (length lst) 10))
+		   (setq lst (cons (match-string 1) lst)))
+		 (nreverse lst)))
+	     (save-excursion
+	       (let ((lst nil))
+		 (while (and (re-search-backward
+			      (concat "\\<\\(" matlab-block-beg-pre-no-if
+				      "\\)\\s-+(?\\s-*\\(" prefix
+				      "\\w+\\)\\>")
+			      bounds t)
+			     (< (length lst) 10))
+		   (setq lst (cons (match-string 2) lst)))
+		 (nreverse lst)))
+	     (save-excursion
+	       (if (re-search-backward "^\\s-*global\\s-+" bounds t)
+		   (let ((lst nil) m e)
+		     (goto-char (match-end 0))
+		     (while (looking-at "\\(\\w+\\)\\([ \t]+\\|$\\)")
+		       (setq m (match-string 1)
+			     e (match-end 0))
+		       (if (equal 0 (string-match prefix m))
+			   (setq lst (cons m lst)))
+		       (goto-char e))
+		     (nreverse lst))))
+	     (save-excursion
+	       (if (and (re-search-backward "^\\s-*function\\>" bounds t)
+			(re-search-forward "\\<\\(\\w+\\)("
+					   (matlab-point-at-eol) t))
+		   (let ((lst nil) m e)
+		     (while (looking-at "\\(\\w+\\)\\s-*[,)]\\s-*")
+		       (setq m (match-string 1)
+			     e (match-end 0))
+		       (if (equal 0 (string-match prefix m))
+			   (setq lst (cons m lst)))
+		       (goto-char e))
+		     (nreverse lst))))))
+	   (fl nil))
+      (while syms
+	(if (car syms) (setq fl (cons (car syms) fl)))
+	(setq syms (cdr syms)))
+      (matlab-uniquafy-list (nreverse fl)))))
+
+(defvar matlab-most-recent-variable-list nil
+  "Maintained by `matlab-find-recent-variable'.")
+
+(defun matlab-find-recent-variable (prefix &optional next)
+  "Return the most recently used variable starting with PREFIX as a string.
+See `matlab-find-recent-variable-list' for details.
+In NEXT is non-nil, than continue through the list of elements."
+  (if next
+      (let ((next (car matlab-most-recent-variable-list)))
+	(setq matlab-most-recent-variable-list
+	      (cdr matlab-most-recent-variable-list))
+	next)
+    (let ((syms (matlab-find-recent-variable-list prefix))
+	  (first nil))
+      (if (eq matlab-completion-technique 'complete)
+	  syms
+	(setq first (car syms))
+	(setq matlab-most-recent-variable-list (cdr syms))
+	first))))
+
+(defun matlab-find-user-functions-list (prefix)
+  "Return a list of user defined functions that match PREFIX."
+  (matlab-navigation-syntax
+    (let ((syms
+	   (append
+	    (save-excursion
+	      (goto-char (point-min))
+	      (let ((lst nil))
+		(while (re-search-forward "^\\s-*function\\>" nil t)
+		  (if (re-search-forward
+		       (concat "\\(" prefix "\\w+\\)\\s-*\\($\\|(\\)")
+		       (matlab-point-at-eol) t)
+		      (setq lst (cons (match-string 1) lst))))
+		(nreverse lst)))
+	    (let ((lst nil)
+		  (files (directory-files
+			  default-directory nil
+			  (concat "^" prefix
+				  "[a-zA-Z][a-zA-Z0-9_]+\\.m$"))))
+	      (while files
+		(setq lst (cons (progn (string-match "\\.m" (car files))
+				       (substring (car files) 0
+						  (match-beginning 0)))
+				lst)
+		      files (cdr files)))
+	      lst)))
+	  (fl nil))
+      (while syms
+	(if (car syms) (setq fl (cons (car syms) fl)))
+	(setq syms (cdr syms)))
+      (matlab-uniquafy-list (nreverse fl)))))
+
+(defvar matlab-user-function-list nil
+  "Maintained by `matlab-find-user-functions'.")
+
+(defun matlab-find-user-functions (prefix &optional next)
+  "Return a user function that match PREFIX and return it.
+If optional argument NEXT is non-nil, then return the next found
+object."
+  (if next
+      (let ((next (car matlab-user-function-list)))
+	(setq matlab-user-function-list (cdr matlab-user-function-list))
+	next)
+    (let ((syms (matlab-find-user-functions-list prefix))
+	  (first nil))
+      (if (eq matlab-completion-technique 'complete)
+	  syms
+	(setq first (car syms))
+	(setq matlab-user-function-list (cdr syms))
+	first))))
+
+(defvar matlab-generic-list-placeholder nil
+  "Maintained by `matalb-generic-list-expand'.
+Holds sub-lists of symbols left to be expanded.")
+
+(defun matlab-generic-list-expand (list prefix &optional next)
+  "Return an element from LIST that start with PREFIX.
+If optional NEXT argument is non nil, then the next element in the
+list is used.  nil is returned if there are not matches."
+  (if next
+      (let ((next (car matlab-generic-list-placeholder)))
+	(setq matlab-generic-list-placeholder
+	      (cdr matlab-generic-list-placeholder))
+	next)
+    (let ((re (concat "^" (regexp-quote prefix)))
+	  (first nil)
+	  (fl nil))
+      (while list
+	(if (string-match re (car list))
+	    (setq fl (cons (car list) fl)))
+	(setq list (cdr list)))
+      (setq fl (nreverse fl))
+      (if (eq matlab-completion-technique 'complete)
+	  fl
+	(setq first (car fl))
+	(setq matlab-generic-list-placeholder (cdr fl))
+	first))))
+
+(defun matlab-solo-completions (prefix &optional next)
+  "Return PREFIX matching elements for solo symbols.
+If NEXT then the next patch from the list is used."
+  (matlab-generic-list-expand matlab-keywords-solo prefix next))
+
+(defun matlab-value-completions (prefix &optional next)
+  "Return PREFIX matching elements for value symbols.
+If NEXT then the next patch from the list is used."
+  (matlab-generic-list-expand matlab-keywords-return prefix next))
+
+(defun matlab-boolean-completions (prefix &optional next)
+  "Return PREFIX matching elements for boolean symbols.
+If NEXT then the next patch from the list is used."
+  (matlab-generic-list-expand matlab-keywords-boolean prefix next))
+ 
+(defun matlab-property-completions (prefix &optional next)
+  "Return PREFIX matching elements for property names in strings.
+If NEXT then the next property from the list is used."
+  (let ((f (matlab-function-called-at-point))
+	(lst matlab-property-lists)
+	(foundlst nil)
+	(expandto nil))
+    ;; Look for this function.  If it is a known function then we
+    ;; can now use a subset of available properties!
+    (while (and lst (not foundlst))
+      (if (string= (car (car lst)) f)
+	  (setq foundlst (cdr (car lst))))
+      (setq lst (cdr lst)))
+    (if foundlst
+	(setq foundlst (append foundlst matlab-core-properties))
+      (setq foundlst matlab-all-known-properties))
+    (setq expandto (matlab-generic-list-expand foundlst prefix next))
+    ;; This looks to see if we have a singular completion.  If so,
+    ;; then return it, and also append the "'" to the end.
+    (cond ((and (listp expandto) (= (length expandto) 1))
+	   (setq expandto (list (concat (car expandto) "'"))))
+	  ((stringp expandto)
+	   (setq expandto (concat expandto "'"))))
+    expandto))
+
+(defvar matlab-last-prefix nil
+  "Maintained by `matlab-complete-symbol'.
+The prefix used for the first completion command.")
+(defvar matlab-last-semantic nil
+  "Maintained by `matlab-complete-symbol'.
+The last type of semantic used while completing things.")
+(defvar matlab-completion-search-state nil
+  "List of searching things we will be doing.")
+
+(defun matlab-complete-symbol (&optional arg)
+  "Complete a partially typed symbol in a MATLAB mode buffer.
+If the previously entered command was also `matlab-complete-symbol'
+then undo the last completion, and find a new one.
+  The types of symbols tried are based on the semantics of the current
+cursor position.  There are two types of symbols.  For example, if the
+cursor is in an if statement, boolean style functions and symbols are
+tried first.  If the line is blank, then flow control, or high level
+functions are tried first.
+  The completion technique is controlled with `matlab-completion-technique'
+It defaults to incremental completion described above.  If a
+completion list is preferred, then change this to 'complete.  If you
+just want a completion list once, then use the universal argument ARG
+to change it temporarily."
+  (interactive "P")
+  (matlab-navigation-syntax
+    (let* ((prefix (if (and (not (eq last-command 'matlab-complete-symbol))
+			    (member (preceding-char) '(?  ?\t ?\n ?, ?\( ?\[ ?\')))
+		       ""
+		     (buffer-substring-no-properties
+		      (save-excursion (forward-word -1) (point))
+		      (point))))
+	   (sem (matlab-lattr-semantics prefix))
+	   (matlab-completion-technique
+	    (if arg (cond ((eq matlab-completion-technique 'complete)
+			   'increment)
+			  (t 'complete))
+	      matlab-completion-technique)))
+      (if (not (eq last-command 'matlab-complete-symbol))
+	  (setq matlab-last-prefix prefix
+		matlab-last-semantic sem
+		matlab-completion-search-state
+		(cond ((eq sem 'solo)
+		       '(matlab-solo-completions
+			 matlab-find-user-functions
+			 matlab-find-recent-variable))
+		      ((eq sem 'boolean)
+		       '(matlab-find-recent-variable
+			 matlab-boolean-completions
+			 matlab-find-user-functions
+			 matlab-value-completions))
+		      ((eq sem 'value)
+		       '(matlab-find-recent-variable
+			 matlab-find-user-functions
+			 matlab-value-completions
+			 matlab-boolean-completions))
+		      ((eq sem 'property)
+		       '(matlab-property-completions
+			 matlab-find-user-functions
+			 matlab-find-recent-variable
+			 matlab-value-completions))
+		      (t '(matlab-find-recent-variable
+			   matlab-find-user-functions
+			   matlab-value-completions
+			   matlab-boolean-completions)))))
+      (cond
+       ((eq matlab-completion-technique 'increment)
+	(let ((r nil) (donext (eq last-command 'matlab-complete-symbol)))
+	  (while (and (not r) matlab-completion-search-state)
+	    (message "Expand with %S" (car matlab-completion-search-state))
+	    (setq r (funcall (car matlab-completion-search-state)
+			     matlab-last-prefix donext))
+	    (if (not r) (setq matlab-completion-search-state
+			      (cdr matlab-completion-search-state)
+			      donext nil)))
+	  (delete-region (point) (progn (forward-char (- (length prefix)))
+					(point)))
+	  (if r
+	      (insert r)
+	    (insert matlab-last-prefix)
+	    (message "No completions."))))
+       ((eq matlab-completion-technique 'complete)
+	(let ((allsyms (apply 'append
+			      (mapcar (lambda (f) (funcall f prefix))
+				      matlab-completion-search-state))))
+	  (cond ((null allsyms)
+		 (message "No completions.")
+		 (ding))
+		((= (length allsyms) 1)
+		 (delete-region (point) (progn
+					  (forward-char (- (length prefix)))
+					  (point)))
+		 (insert (car allsyms)))
+		((= (length allsyms) 0)
+		 (message "No completions."))
+		(t
+		 (let* ((al (mapcar (lambda (a) (list a)) allsyms))
+			(c (try-completion prefix al)))
+		   ;; This completion stuff lets us expand as much as is
+		   ;; available to us. When the completion is the prefix
+		   ;; then we want to display all the strings we've
+		   ;; encountered.
+		   (if (and (stringp c) (not (string= prefix c)))
+		       (progn
+			 (delete-region
+			  (point)
+			  (progn (forward-char (- (length prefix)))
+				 (point)))
+			 (insert c))
+		     ;; `display-completion-list' does all the complex
+		     ;; ui work for us.
+		     (with-output-to-temp-buffer "*Completions*"
+		       (display-completion-list
+			(matlab-uniquafy-list allsyms)))))))))))))
+
+(defun matlab-insert-end-block (&optional reindent)
+  "Insert and END block based on the current syntax.
+Optional argument REINDENT indicates if the specified block should be re-indented."
+  (interactive "P")
+  (if (not (matlab-ltype-empty)) (progn (end-of-line) (insert "\n")))
+  (let ((valid t) (begin nil))
+    (save-excursion
+      (condition-case nil
+	  (progn
+	    (matlab-backward-sexp t)
+	    (setq begin (point)
+		  valid (buffer-substring-no-properties
+			 (point) (save-excursion
+				   (re-search-forward "[\n,;.]" nil t)
+				   (point)))))
+	(error (setq valid nil))))
+    (if (not valid)
+	(error "No block to end")
+      (insert "end")
+      (if (stringp valid) (insert " % " valid))
+      (matlab-indent-line)
+      (if reindent (indent-region begin (point) nil)))))
+
+(tempo-define-template
+ "matlab-for"
+ '("for " p "=" p "," > n>
+     r> &
+     "end" > %)
+ "for"
+ "Insert a MATLAB for statement"
+ 'matlab-tempo-tags
+ )
+
+(tempo-define-template
+ "matlab-while"
+ '("while (" p ")," > n>
+     r> &
+     "end" > %)
+ "while"
+ "Insert a MATLAB while statement"
+ 'matlab-tempo-tags
+ )
+
+(tempo-define-template
+ "matlab-if"
+ '("if " p > n
+     r>
+     "end" > n)
+ "if"
+ "Insert a MATLAB if statement"
+ 'matlab-tempo-tags
+ )
+
+(tempo-define-template
+ "matlab-if-else"
+ '("if " p > n
+     r>
+     "else" > n
+     "end" > n)
+ "if"
+ "Insert a MATLAB if statement"
+ 'matlab-tempo-tags
+ )
+
+(tempo-define-template
+ "matlab-try"
+ '("try " > n
+     r>
+     "catch" > n
+     p > n
+     "end" > n)
+ "try"
+ "Insert a MATLAB try catch statement"
+ 'matlab-tempo-tags
+ )
+
+(tempo-define-template
+ "matlab-switch"
+ '("switch " p > n
+     "otherwise" > n
+     r>
+     "end" > n)
+ "switch"
+ "Insert a MATLAB switch statement with region in the otherwise clause."
+ 'matlab-tempo-tags)
+
+(defun matlab-insert-next-case ()
+  "Insert a case statement inside this switch statement."
+  (interactive)
+  ;; First, make sure we are where we think we are.
+  (let ((valid t))
+    (save-excursion
+      (condition-case nil
+	  (progn
+	   (matlab-backward-sexp t)
+	   (setq valid (looking-at "switch")))
+	(error (setq valid nil))))
+    (if (not valid)
+	(error "Not in a switch statement")))
+  (if (not (matlab-ltype-empty)) (progn (end-of-line) (insert "\n")))
+  (indent-to 0)
+  (insert "case ")
+  (matlab-indent-line))
+
+(tempo-define-template
+ "matlab-function"
+ '("function "
+     (P "output argument(s): " output t)
+     ;; Insert brackets only if there is more than one output argument
+     (if (string-match "," (tempo-lookup-named 'output))
+	 '(l "[" (s output) "]")
+       '(l (s output)))
+     ;; Insert equal sign only if there is output argument(s)
+     (if (= 0 (length (tempo-lookup-named 'output))) nil
+       " = ")
+     ;; The name of a function, as defined in the first line, should
+     ;; be the same as the name of the file without .m extension
+     (if (= 1 (count-lines 1 (point)))
+	 (tempo-save-named
+	  'fname
+	  (file-name-nondirectory (file-name-sans-extension
+				   (buffer-file-name))))
+       '(l (P "function name: " fname t)))
+     (tempo-lookup-named 'fname)
+     "("  (P "input argument(s): ") ")" n
+     "% " (upcase (tempo-lookup-named 'fname)) " - " (P "H1 line: ") n
+     "%   " p n
+     (if matlab-functions-have-end
+         '(l "end" n)))
+ "function"
+ "Insert a MATLAB function statement"
+ 'matlab-tempo-tags
+ )
+
+(defun matlab-stringify-region (begin end)
+  "Put MATLAB 's around region, and quote all quotes in the string.
+Stringification allows you to type in normal MATLAB code, mark it, and
+then turn it into a MATLAB string that will output exactly what's in
+the region.  BEGIN and END mark the region to be stringified."
+  (interactive "r")
+  (save-excursion
+    (goto-char begin)
+    (if (re-search-forward "\n" end t)
+	(error
+	 "You may only stringify regions that encompass less than one line"))
+    (let ((m (make-marker)))
+      (move-marker m end)
+      (goto-char begin)
+      (insert "'")
+      (while (re-search-forward "'" m t)
+	(insert "'"))
+      (goto-char m)
+      (insert "'"))))
+
+(defun matlab-ispell-strings-region (begin end)
+  "Spell check valid strings in region with Ispell.
+Argument BEGIN and END mark the region boundary."
+  (interactive "r")
+  (require 'ispell)
+  (save-excursion
+    (goto-char begin)
+    ;; Here we use the font lock function for finding strings.
+    ;; Its cheap, fast, and accurate.
+    (while (and (matlab-font-lock-string-match-normal end)
+		(ispell-region (match-beginning 2) (match-end 2))))))
+
+(defun matlab-ispell-strings ()
+  "Spell check valid strings in the current buffer with Ispell.
+Calls `matlab-ispell-strings-region'"
+  (interactive)
+  (matlab-ispell-strings-region (point-min) (point-max)))
+
+(defun matlab-ispell-comments (&optional arg)
+  "Spell check comments in the current buffer with Ispell.
+Optional ARG means to only check the current comment."
+  (interactive "P")
+  (let ((beg (point-min))
+	(end (point-max)))
+  (if (and arg (matlab-ltype-comm))
+      (setq beg (save-excursion (matlab-beginning-of-command) (point))
+	    end (save-excursion (matlab-end-of-command) (point))))
+  (save-excursion
+    (goto-char beg)
+    (beginning-of-line)
+    (while (and (matlab-font-lock-comment-match end)
+		(ispell-region (match-beginning 1) (match-end 1)))))))
+
+(defun matlab-generate-latex ()
+  "Convert a MATLAB M file into a Latex document for printing.
+Author: Uwe Brauer oub@eucmos.sim.ucm.es
+Created: 14 Feb 2002"
+  (interactive "*")
+  (save-restriction
+    (save-excursion
+      (goto-char (point-min))
+      (insert "\\documentclass[12pt]{report}\n
+\\usepackage{listings}
+\\lstloadlanguages{Matlab}
+\\lstset{language=Matlab,keywordstyle=\\bfseries,labelstep=1,escapechar=\\#}
+\\begin{document}
+\\begin{lstlisting}{}")
+      (newline)
+      (goto-char (point-max))
+      (insert "\n\\end{lstlisting}\n\\end{document}")
+      (widen)))
+  (font-lock-mode nil)
+  (LaTeX-mode)
+  (font-lock-mode nil))
+
+
+;;; Block highlighting ========================================================
+
+(defvar matlab-block-highlighter-timer nil
+  "The timer representing the block highlighter.")
+
+(defun matlab-enable-block-highlighting (&optional arg)
+  "Start or stop the block highlighter.
+Optional ARG is 1 to force enable, and -1 to disable.
+If ARG is nil, then highlighting is toggled."
+  (interactive "P")
+  (if (not (fboundp 'matlab-run-with-idle-timer))
+      (setq matlab-highlight-block-match-flag nil))
+  ;; Only do it if it's enabled.
+  (if (not matlab-highlight-block-match-flag)
+      nil
+    ;; Use post command idle hook as a local hook to dissuade too much
+    ;; cpu time while doing other things.
+    ;;(make-local-hook 'post-command-hook)
+    (if (not arg)
+	(setq arg
+	      (if (member 'matlab-start-block-highlight-timer
+			  post-command-hook)
+		  -1 1)))
+    (if (> arg 0)
+	(add-hook 'post-command-hook 'matlab-start-block-highlight-timer)
+      (remove-hook 'post-command-hook 'matlab-start-block-highlight-timer))))
+
+(defvar matlab-block-highlight-overlay nil
+  "The last highlighted overlay.")
+(make-variable-buffer-local 'matlab-block-highlight-overlay)
+
+(defvar matlab-block-highlight-timer nil
+  "Last started timer.")
+(make-variable-buffer-local 'matlab-block-highlight-timer)
+
+(defun matlab-start-block-highlight-timer ()
+  "Set up a one-shot timer if we are in MATLAB mode."
+  (if (eq major-mode 'matlab-mode)
+      (progn
+	(if matlab-block-highlight-overlay
+	    (unwind-protect
+		(matlab-delete-overlay matlab-block-highlight-overlay)
+	      (setq matlab-block-highlight-overlay nil)))
+	(if matlab-block-highlight-timer
+	    (unwind-protect
+		(matlab-cancel-timer matlab-block-highlight-timer)
+	      (setq matlab-block-highlight-timer nil)))
+	(setq matlab-block-highlight-timer
+	      (matlab-run-with-idle-timer
+	       1 nil 'matlab-highlight-block-match
+	       (current-buffer))))))
+  
+(defun matlab-highlight-block-match (&optional buff-when-launched)
+  "Highlight a matching block if available.
+BUFF-WHEN-LAUNCHED is the buffer that was active when the timer was set."
+  (setq matlab-block-highlight-timer nil)
+  (if (null buff-when-launched)
+      ;; We were passed a null.  This indicates an old version of XEmacs
+      ;; so just turn the feature off
+      (setq matlab-highlight-block-match-flag nil)
+  ;; Only do neat stuff in the same buffer as the one we were
+  ;; initialized from.
+  (when (and buff-when-launched
+	     (eq buff-when-launched (current-buffer)))
+    (let ((inhibit-quit nil)		;turn on G-g
+	  (matlab-scan-on-screen-only t))
+      (if matlab-show-periodic-code-details-flag
+	  (matlab-show-line-info))
+      (if (not (matlab-cursor-in-string-or-comment))
+	  (save-excursion
+	    (if (or (bolp)
+		    (looking-at "\\s-")
+		    (save-excursion (forward-char -1) (looking-at "\\s-")))
+		nil
+	      (forward-word -1))
+	    (if (and (looking-at (concat (matlab-block-beg-re) "\\>"))
+		     (not (looking-at "function")))
+		(progn
+		  ;; We scan forward...
+		  (matlab-forward-sexp)
+		  (backward-word 1)
+		  (if (not (looking-at matlab-block-end-pre-if))
+		      nil ;(message "Unterminated block, or end off screen.")
+		    (setq matlab-block-highlight-overlay
+			  (matlab-make-overlay (point)
+					       (progn (forward-word 1)
+						      (point))
+					       (current-buffer)))
+		    (matlab-overlay-put matlab-block-highlight-overlay
+					'face 'matlab-region-face)))
+	      (if (and (looking-at (concat (matlab-block-end-pre) "\\>"))
+		       (not (looking-at "function"))
+		       (matlab-valid-end-construct-p))
+		  (progn
+		    ;; We scan backward
+		    (forward-word 1)
+		    (condition-case nil
+			(progn
+			  (matlab-backward-sexp)
+			  (if (not (looking-at (matlab-block-beg-re)))
+			      nil ;(message "Unstarted block at cursor.")
+			    (setq matlab-block-highlight-overlay
+				  (matlab-make-overlay (point)
+						       (progn (forward-word 1)
+							      (point))
+						       (current-buffer)))
+			    (matlab-overlay-put matlab-block-highlight-overlay
+						'face 'matlab-region-face)))
+		      (error (message "Unstarted block at cursor."))))
+		;; do nothing
+		))))))))
+
+
+;;; M Block Folding with hideshow =============================================
+
+(defun matlab-hideshow-forward-sexp-func (arg)
+  "Move forward one sexp for hideshow.
+Argument ARG specifies the number of blocks to move forward."
+  (beginning-of-line)
+  (matlab-forward-sexp arg)
+  )
+
+(defun matlab-hideshow-adjust-beg-func (arg)
+  "Adjust the beginning of a hideshow block.
+Argument ARG to make it happy."
+  (end-of-line)
+  (point)
+  )
+
+;; Use this to enable hideshow in MATLAB.
+;; It has not been tested by me enough.
+
+;; REMOVE PUSHNEW FROM THIS LINE
+;;(pushnew (list 'matlab-mode 
+;;	       (matlab-block-beg-pre)
+;;	       (matlab-block-end-pre)
+;;	       "%"
+;;	       'matlab-hideshow-forward-sexp-func
+;;	       'matlab-hideshow-adjust-beg-func
+;;	       )
+;;	 hs-special-modes-alist :test 'equal)
+
+
+;;; M Code verification & Auto-fix ============================================
+
+(defun matlab-mode-verify-fix-file-fn ()
+  "Verify the current buffer from `write-contents-hooks'."
+  (if matlab-verify-on-save-flag
+      (matlab-mode-verify-fix-file (> (point-max)
+				      matlab-block-verify-max-buffer-size)))
+  ;; Always return nil.
+  nil)
+
+(defun matlab-mode-verify-fix-file (&optional fast)
+  "Verify the current buffer satisfies all M things that might be useful.
+We will merely loop across a list of verifiers/fixers in
+`matlab-mode-verify-fix-functions'.
+If optional FAST is non-nil, do not perform usually lengthy checks."
+  (interactive)
+  (let ((p (point))
+	(l matlab-mode-verify-fix-functions))
+    (while l
+      (funcall (car l) fast)
+      (setq l (cdr l)))
+    (goto-char p))
+  (if (interactive-p)
+      (message "Done.")))
+
+(defun matlab-toggle-show-mlint-warnings ()
+  "Toggle `matlab-show-mlint-warnings'."
+  (interactive)
+  (setq matlab-show-mlint-warnings (not matlab-show-mlint-warnings))
+  (if matlab-highlight-cross-function-variables
+      (if matlab-show-mlint-warnings
+          (mlint-buffer)        ; became true, recompute mlint info
+        (mlint-clear-warnings))) ; became false, just remove hilighting
+  ;; change mlint mode altogether
+  (mlint-minor-mode 
+   (if (or matlab-highlight-cross-function-variables
+           matlab-show-mlint-warnings)
+       1 -1)))
+
+(defun matlab-toggle-highlight-cross-function-variables ()
+  "Toggle `matlab-highlight-cross-function-variables'."
+  (interactive)
+  (setq matlab-highlight-cross-function-variables
+        (not matlab-highlight-cross-function-variables))
+  (if matlab-show-mlint-warnings
+      (if matlab-highlight-cross-function-variables
+          (mlint-buffer)        ; became true, recompute mlint info
+                                ; became false, just remove hilighting ...
+        (mlint-clear-cross-function-variable-highlighting)))
+  (mlint-minor-mode 
+   (if (or matlab-highlight-cross-function-variables
+           matlab-show-mlint-warnings)
+       1 -1)))        ; change mlint mode altogether
+
+;;
+;; Add more auto verify/fix functions here!
+;;
+(defun matlab-mode-vf-functionname (&optional fast)
+  "Verify/Fix the function name of this file.
+Optional argument FAST is ignored."
+  (matlab-navigation-syntax
+    (goto-char (point-min))
+    (while (and (or (matlab-ltype-empty) (matlab-ltype-comm))
+		(/= (matlab-point-at-eol) (point-max)))
+      (forward-line 1))
+    (let ((func nil)
+	  (bn (file-name-sans-extension
+	       (file-name-nondirectory (buffer-file-name)))))
+    (if (looking-at (matlab-match-function-re))
+	;; The expression above creates too many numeric matches
+	;; to apply a known one to our function.  We cheat by knowing that
+	;; match-end 0 is at the end of the function name.  We can then go
+	;; backwards, and get the extents we need.  Navigation syntax
+	;; lets us know that backward-word really covers the word.
+	(let ((end (match-end 0))
+	      (begin (progn (goto-char (match-end 0))
+			    (forward-word -1)
+			    (point))))
+	  (setq func (buffer-substring begin end))
+	  (if (not (string= func bn))
+	      (if (not (matlab-mode-highlight-ask
+			begin end
+			"Function and file names are different. Fix?"))
+		  nil
+		(goto-char begin)
+		(delete-region begin end)
+		(insert bn))))))))
+
+(defun matlab-mode-vf-block-matches-forward (&optional fast)
+  "Verify/Fix unterminated (or un-ended) blocks.
+This only checks block regions like if/end.
+Optional argument FAST causes this check to be skipped."
+  (goto-char (point-min))
+  (let ((go t)
+	(expr (concat "\\<\\(" (matlab-block-beg-pre) "\\)\\>")))
+    (matlab-navigation-syntax
+      (while (and (not fast) go (re-search-forward expr nil t))
+	(forward-word -1)		;back over the special word
+	(let ((s (point)))
+	  (condition-case nil
+	      (if (and (not (matlab-cursor-in-string-or-comment))
+		       (not (looking-at "function")))
+		  (progn
+		    (matlab-forward-sexp)
+		    (forward-word -1)
+		    (if (not (looking-at
+			      (concat matlab-block-end-pre-no-if "\\>")))
+			(setq go nil)))
+		(forward-word 1))
+	    (error (setq go nil)))
+	  (if (and (not go) (goto-char s)
+		   (not (matlab-mode-highlight-ask
+			 (point) (save-excursion (forward-word 1) (point))
+			 "Unterminated block.  Continue anyway?")))
+	      (error "Unterminated Block found!")))
+	(message "Block-check: %d%%" (/ (/ (* 100 (point)) (point-max)) 2))))))
+  
+(defun matlab-mode-vf-block-matches-backward (&optional fast)
+  "Verify/fix unstarted (or dangling end) blocks.
+Optional argument FAST causes this check to be skipped."
+  (goto-char (point-max))
+  (let ((go t) (expr (concat "\\<\\(" (matlab-block-end-no-function-re)
+			     "\\)\\>")))
+    (matlab-navigation-syntax
+      (while (and (not fast) go (re-search-backward expr nil t))
+	(forward-word 1)
+	(let ((s (point)))
+	  (condition-case nil
+	      (if (and (not (matlab-cursor-in-string-or-comment))
+		       (matlab-valid-end-construct-p))
+		  (matlab-backward-sexp)
+		(backward-word 1))
+	    (error (setq go nil)))
+	  (if (and (not go) (goto-char s)
+		   (not (matlab-mode-highlight-ask
+			 (point) (save-excursion (backward-word 1) (point))
+			 "Unstarted block.  Continue anyway?")))
+	      (error "Unstarted Block found!")))
+	(message "Block-check: %d%%"
+		 (+ (/ (/ (* 100 (- (point-max) (point))) (point-max)) 2) 50))))))
+
+;;; Utility for verify/fix actions if you need to highlight
+;;  a section of the buffer for the user's approval.
+(defun matlab-mode-highlight-ask (begin end prompt)
+  "Highlight from BEGIN to END while asking PROMPT as a yes-no question."
+  (let ((mo (matlab-make-overlay begin end (current-buffer)))
+	(ans nil))
+    (condition-case nil
+	(progn
+	  (matlab-overlay-put mo 'face 'matlab-region-face)
+	  (setq ans (y-or-n-p prompt))
+	  (matlab-delete-overlay mo))
+      (quit (matlab-delete-overlay mo) (error "Quit")))
+    ans))
+
+;;; Quiesce an M file to remove accidental display of ANS during a run.
+;;  Useful if you have random outputs and you don't know where they are from,
+;;  or before compiling to standalone where some functions now have outputs
+;;  that did not have outputs earlier.
+;;
+;;  You probably don't want this as a default verify function
+(defvar matlab-quiesce-nosemi-regexp "\\s-*\\(function\\|parfor\\|for\\|spmd\\|while\\|try\\|catch\\|\
+switch\\|otherwise\\|case\\|break\\|if\\|else\\|end\\|return\\|disp\\|\
+$\\|%\\)"
+  "Regular expression used to detect if a semicolon is needed at the end of a line.")
+
+(defun matlab-mode-vf-quiesce-buffer (&optional fast)
+  "Find all commands that do not end in ;, and add one.
+This has the effect of removing any extraneous output that may not be
+desired.  Optional argument FAST is not used."
+  (interactive)
+  (save-excursion
+    (push-mark)
+    (goto-char (point-min))
+    (let ((msgpos 0) (dir .2))
+      (while (not (save-excursion (end-of-line) (eobp)))
+	(message (aref [ "Scanning o...." "Scanning .o..." "Scanning ..o.."
+			 "Scanning ...o." "Scanning ....o" ] (floor msgpos)))
+	(setq msgpos (+ msgpos dir))
+	(if (or (> msgpos 5) (< msgpos 0)) (setq dir (- dir)
+						 msgpos (+ (* 2 dir) msgpos)))
+	(matlab-end-of-command (point))
+	(if (matlab-cursor-in-comment)
+	    (progn
+	      (matlab-comment-on-line)
+	      (skip-chars-backward " \t")))
+	(if (and (not (= (preceding-char) ?\;))
+		 (not (matlab-cursor-in-string t))
+		 (not (save-excursion
+			(beginning-of-line)
+			(looking-at matlab-quiesce-nosemi-regexp))))
+	    (let ((p (point)))
+	      (skip-chars-backward " \t")
+	      (if (/= p (point))
+		  (progn
+		    (delete-region p (point))
+		    (forward-line -1))
+		(if (matlab-mode-highlight-ask (point) (+ 1 (point))
+					       "Add Semi colon here? ")
+		    (insert ";")))))
+	(forward-line 1))))
+  (message "Scanning .... done"))
+  
+
+
+;;; V19 stuff =================================================================
+
+(defvar matlab-mode-menu-keymap nil
+  "Keymap used in MATLAB mode to provide a menu.")
+
+(defun matlab-frame-init ()
+  "Initialize Emacs menu system."
+  (interactive)
+  ;; make a menu keymap
+  (easy-menu-define
+   matlab-mode-menu
+   matlab-mode-map
+   "MATLAB menu"
+   '("MATLAB"
+     ["Start MATLAB" matlab-shell
+      :active (not (or (matlab-with-emacs-link) (matlab-shell-active-p)))
+      :visible (not (matlab-shell-active-p)) ]
+     ["Switch to MATLAB" matlab-shell
+      :active (and (not (matlab-with-emacs-link)) (matlab-shell-active-p))
+      :visible (matlab-shell-active-p) ]
+     ["Save and go" matlab-shell-save-and-go t]
+     ["Run Region" matlab-shell-run-region t]
+     ["Run Cell" matlab-shell-run-cell t]
+     ["Version" matlab-show-version t]
+     "----"
+     ["Find M file" matlab-find-file-on-path t]
+     ["Show M-Lint Warnings" matlab-toggle-show-mlint-warnings
+      :active (and (locate-library "mlint") (fboundp 'mlint-minor-mode))
+      :style toggle :selected  matlab-show-mlint-warnings
+      ]
+     ("Auto Fix"
+      ["Verify/Fix source" matlab-mode-verify-fix-file t]
+      ["Spell check strings" matlab-ispell-strings t]
+      ["Spell check comments" matlab-ispell-comments t]
+      ["Quiesce source" matlab-mode-vf-quiesce-buffer t]
+      )
+     ("Navigate"
+      ["Beginning of Command" matlab-beginning-of-command t]
+      ["End of Command" matlab-end-of-command t]
+      ["Forward Block" matlab-forward-sexp t]
+      ["Backward Block" matlab-backward-sexp t]
+      ["Beginning of Function" matlab-beginning-of-defun t]
+      ["End of Function" matlab-end-of-defun t])
+     ("Format"
+      ["Justify Line" matlab-justify-line t]
+      ["Fill Region" matlab-fill-region t]
+      ["Fill Comment Paragraph" matlab-fill-paragraph
+       (save-excursion (matlab-comment-on-line))]
+      ["Join Comment" matlab-join-comment-lines
+       (save-excursion (matlab-comment-on-line))]
+      ["Comment Region" matlab-comment-region t]
+      ["Uncomment Region" matlab-uncomment-region t]
+      ["Indent Synactic Block" matlab-indent-sexp])
+     ("Insert"
+      ["Complete Symbol" matlab-complete-symbol t]
+      ["Comment" matlab-comment t]
+      ["if end" tempo-template-matlab-if t]
+      ["if else end" tempo-template-matlab-if-else t]
+      ["for end" tempo-template-matlab-for t]
+      ["switch otherwise end" tempo-template-matlab-switch t]
+      ["Next case" matlab-insert-next-case t]
+      ["try catch end" tempo-template-matlab-try t]
+      ["while end" tempo-template-matlab-while t]
+      ["End of block" matlab-insert-end-block t]
+      ["Function" tempo-template-matlab-function t]
+      ["Stringify Region" matlab-stringify-region t]
+      )
+     ("Customize"
+;      ["Auto Fill Counts Elipsis"
+;       (lambda () (setq matlab-fill-count-ellipsis-flag
+;			(not matlab-fill-count-ellipsis-flag)))
+;       :style toggle :selected 'matlab-fill-count-ellipsis-flag]
+      ["Indent Function Body"
+       (setq matlab-indent-function-body (not (matlab-indent-function-body-p)))
+       :style toggle :selected matlab-indent-function-body]
+      ["Functions Have end"
+       matlab-toggle-functions-have-end
+       :style toggle :selected matlab-functions-have-end]
+      ["Verify File on Save"
+       (setq matlab-verify-on-save-flag (not matlab-verify-on-save-flag))
+       :style toggle :selected matlab-verify-on-save-flag]
+      ["Auto Fill does Code"
+       (setq matlab-fill-code (not matlab-fill-code))
+       :style toggle :selected matlab-fill-code ]
+      ["Periodic Code Details"
+       (setq matlab-show-periodic-code-details-flag
+	     (not matlab-show-periodic-code-details-flag))
+       :style toggle :selected matlab-show-periodic-code-details-flag ]
+      ["Highlight Matching Blocks"
+       (matlab-enable-block-highlighting)
+       :style toggle :selected (member 'matlab-start-block-highlight-timer
+				       post-command-hook) ]
+      ["Highlight Cross-Function Variables"
+       matlab-toggle-highlight-cross-function-variables
+       :active (locate-library "mlint")
+       :style toggle :selected  matlab-highlight-cross-function-variables
+       ]
+      ["Add Needed Semicolon on RET"
+       (setq matlab-return-add-semicolon (not matlab-return-add-semicolon))
+       :style toggle :selected  matlab-return-add-semicolon
+       ]
+      ["Customize" (customize-group 'matlab)
+       (and (featurep 'custom) (fboundp 'custom-declare-variable))
+       ]
+      )
+     "----"
+     ["Run M Command" matlab-shell-run-command (matlab-shell-active-p)]
+     ["Describe Command" matlab-shell-describe-command (matlab-shell-active-p)]
+     ["Describe Variable" matlab-shell-describe-variable (matlab-shell-active-p)]
+     ["Command Apropos" matlab-shell-apropos (matlab-shell-active-p)]
+     ["Topic Browser" matlab-shell-topic-browser (matlab-shell-active-p)]
+     ))
+  (easy-menu-add matlab-mode-menu matlab-mode-map))
+
+;;; MATLAB shell =============================================================
+
+(defgroup matlab-shell nil
+  "MATLAB shell mode."
+  :prefix "matlab-shell-"
+  :group 'matlab)
+
+(defcustom matlab-shell-command "matlab"
+  "*The name of the command to be run which will start the MATLAB process."
+  :group 'matlab-shell
+  :type 'string)
+
+(defcustom matlab-shell-command-switches '("-nodesktop")
+  "*Command line parameters run with `matlab-shell-command'.
+Command switches are a list of strings.  Each entry is one switch."
+  :group 'matlab-shell
+  :type '(list :tag "Switch: "))
+
+(defcustom matlab-shell-echoes t
+  "*If `matlab-shell-command' echoes input."
+  :group 'matlab-shell
+  :type 'boolean)
+
+(defvar matlab-shell-running-matlab-version nil
+  "The version of MATLAB running in the current `matlab-shell' buffer.")
+(defvar matlab-shell-running-matlab-release nil
+  "The release of MATLAB running in the curbrent `matlab-shell' buffer.")
+(defvar matlab-shell-use-emacs-toolbox
+  ;; matlab may not be on path.  (Name change, explicit load, etc)
+  (let* ((mlfile (locate-library "matlab"))
+	 (dir (expand-file-name "toolbox/emacsinit.m"
+				(file-name-directory (or mlfile "")))))
+    (and mlfile (file-exists-p dir)))
+  "Add the `matlab-shell' MATLAB toolbox to the MATLAB path on startup.")
+(defvar matlab-shell-emacsclient-command "emacsclient -n"
+  "The command to use as an external editor for MATLAB.
+Using emacsclient allows the currently running Emacs to also be the
+external editor for MATLAB.")
+
+(defcustom matlab-shell-history-file "~/.matlab/%s/history.m"
+  "*Location of the history file.
+A %s is replaced with the MATLAB version release number, such as R12. 
+This file is read to initialize the comint input ring.")
+
+(defcustom matlab-shell-input-ring-size 32
+  "*Number of history elements to keep."
+  :group 'matlab-shell
+  :type 'integer)
+
+(defcustom matlab-shell-enable-gud-flag t
+  "*Non-nil means to use GUD mode when running the MATLAB shell."
+  :group 'matlab-shell
+  :type 'boolean)
+
+(defcustom matlab-shell-mode-hook nil
+  "*List of functions to call on entry to MATLAB shell mode."
+  :group 'matlab-shell
+  :type 'hook)
+
+(defcustom matlab-shell-ask-MATLAB-for-completions t
+  "When Non-nil, ask MATLAB for a completion list.
+When nil, just complete file names.  (The original behavior.)
+At this time, MATLAB based completion can be slow if there are
+a lot of possible answers."
+  :group 'matlab-shell
+  :type 'boolean)
+
+(defvar matlab-shell-buffer-name "MATLAB"
+  "Name used to create `matlab-shell' mode buffers.
+This name will have *'s surrounding it.")
+
+(defun matlab-shell-active-p ()
+  "Return t if the MATLAB shell is active."
+  (if (get-buffer (concat "*" matlab-shell-buffer-name "*"))
+      (save-excursion
+	(set-buffer (concat "*" matlab-shell-buffer-name "*"))
+	(if (comint-check-proc (current-buffer))
+	    (current-buffer)))))
+
+(defvar matlab-shell-mode-map ()
+  "Keymap used in `matlab-shell-mode'.")
+
+(defvar matlab-shell-font-lock-keywords-1
+  (append matlab-font-lock-keywords matlab-shell-font-lock-keywords)
+  "Keyword symbol used for font-lock mode.")
+
+(defvar matlab-shell-font-lock-keywords-2
+  (append matlab-shell-font-lock-keywords-1 matlab-gaudy-font-lock-keywords)
+  "Keyword symbol used for gaudy font-lock symbols.")
+
+(defvar matlab-shell-font-lock-keywords-3
+  (append matlab-shell-font-lock-keywords-2
+	  matlab-really-gaudy-font-lock-keywords)
+  "Keyword symbol used for really gaudy font-lock symbols.")
+
+(defvar matlab-prompt-seen nil
+  "Track visibility of MATLAB prompt in MATLAB Shell.")
+
+(eval-when-compile (require 'gud) (require 'comint) (require 'shell))
+
+;;;###autoload
+(defun matlab-shell ()
+  "Create a buffer with MATLAB running as a subprocess.
+
+MATLAB shell cannot work on the MS Windows platform because MATLAB is not
+a console application."
+  (interactive)
+  ;; MATLAB shell does not work by default on the Windows platform.  Only
+  ;; permit it's operation when the shell command string is different from
+  ;; the default value.  (True when the engine program is running.)
+  (if (and (or (eq window-system 'pc) (eq window-system 'w32))
+	   (string= matlab-shell-command "matlab"))
+      (error "MATLAB cannot be run as a inferior process.  \
+Try C-h f matlab-shell RET"))
+
+  (require 'shell)
+  (require 'gud)
+
+  ;; Make sure this is safe...
+  (if (and matlab-shell-enable-gud-flag (fboundp 'gud-def))
+      ;; We can continue using GUD
+      nil
+    (message "Sorry, your emacs cannot use the MATLAB Shell GUD features.")
+    (setq matlab-shell-enable-gud-flag nil))
+
+  (switch-to-buffer (concat "*" matlab-shell-buffer-name "*"))
+  (if (matlab-shell-active-p)
+      nil
+    ;; Clean up crufty state
+    (kill-all-local-variables)
+    ;; Build keymap here in case someone never uses comint mode
+    (if matlab-shell-mode-map
+	()
+      (setq matlab-shell-mode-map
+	    (let ((km (make-sparse-keymap 'matlab-shell-mode-map)))
+	      (if (fboundp 'set-keymap-parent)
+		  (set-keymap-parent km comint-mode-map)
+		;; 19.31 doesn't have set-keymap-parent
+		(setq km (nconc km comint-mode-map)))
+	      (substitute-key-definition 'next-error 'matlab-shell-last-error
+					 km global-map)
+	      (define-key km [(control h) (control m)]
+		matlab-help-map)
+              (define-key km "\C-c." 'matlab-find-file-on-path)
+	      (define-key km [(tab)] 'matlab-shell-tab)
+	      (define-key km "\C-i" 'matlab-shell-tab)
+	      (define-key km [(control up)]
+		'comint-previous-matching-input-from-input)
+	      (define-key km [(control down)]
+		'comint-next-matching-input-from-input)
+	      (define-key km [up]
+		'matlab-shell-previous-matching-input-from-input)
+	      (define-key km [down]
+		'matlab-shell-next-matching-input-from-input)
+	      (define-key km [(control return)] 'comint-kill-input)
+	      (define-key km "\C-?"
+		'matlab-shell-delete-backwards-no-prompt)
+	      (define-key km [(backspace)]
+		'matlab-shell-delete-backwards-no-prompt)
+	      km)))
+    (switch-to-buffer
+     ;; Thx David Chappaz for reminding me about this patch.
+     (let* ((windowid (frame-parameter (selected-frame) 'outer-window-id))
+            (newvar (concat "WINDOWID=" windowid))
+            (process-environment (cons newvar process-environment)))
+       (apply 'make-comint matlab-shell-buffer-name matlab-shell-command
+              nil matlab-shell-command-switches)))
+    
+    (setq shell-dirtrackp t)
+    (comint-mode)
+
+    (if matlab-shell-enable-gud-flag
+	(progn
+	  (gud-mode)
+          (make-local-variable 'matlab-prompt-seen)
+          (setq matlab-prompt-seen nil)
+	  (make-local-variable 'gud-marker-filter)
+	  (setq gud-marker-filter 'gud-matlab-marker-filter)
+	  (make-local-variable 'gud-find-file)
+	  (setq gud-find-file 'gud-matlab-find-file)
+
+	  (set-process-filter (get-buffer-process (current-buffer))
+			      'gud-filter)
+	  (set-process-sentinel (get-buffer-process (current-buffer))
+				'gud-sentinel)
+	  (gud-set-buffer))
+      ;; What to do when there is no GUD
+      ;(set-process-filter (get-buffer-process (current-buffer))
+	;		  'matlab-shell-process-filter)
+      )
+
+    ;; Comint and GUD both try to set the mode.  Now reset it to
+    ;; matlab mode.
+    (matlab-shell-mode)))
+
+(defcustom matlab-shell-logo
+  (if (fboundp 'locate-data-file)
+      ;; Starting from XEmacs 20.4 use locate-data-file
+      (locate-data-file "matlab.xpm")
+    (expand-file-name "matlab.xpm" data-directory))
+  "*The MATLAB logo file."
+  :group 'matlab-shell
+  :type '(choice (const :tag "None" nil)
+		 (file :tag "File" "")))
+
+ 
+(defun matlab-shell-hack-logo (str)
+  "Replace the text logo with a real logo.
+STR is passed from the commint filter."
+  (when (string-match "< M A T L A B >" str)
+    (save-excursion
+      (when (re-search-backward "^[ \t]+< M A T L A B (R) >" (point-min) t)
+ 	(delete-region (match-beginning 0) (match-end 0))
+ 	(insert (make-string 16 ? ))
+ 	(set-extent-begin-glyph (make-extent (point) (point))
+ 				(make-glyph matlab-shell-logo))))
+    ;; Remove this function from `comint-output-filter-functions'
+    (remove-hook 'comint-output-filter-functions
+ 		 'matlab-shell-hack-logo))
+  
+  )
+
+(defun matlab-shell-version-scrape (str)
+  "Scrape the MATLAB Version from the MATLAB startup text.
+Argument STR is the string to examine for version information."
+  (when (string-match "\\(Version\\)\\s-+\\([.0-9]+\\)\\s-+(\\(R[.0-9]+[ab]?\\))" str)
+    ;; Extract the release number
+    (setq matlab-shell-running-matlab-version
+	  (match-string 2 str)
+	  matlab-shell-running-matlab-release
+	  (match-string 3 str))
+    ;; Now get our history loaded
+    (setq comint-input-ring-file-name
+	  (format matlab-shell-history-file matlab-shell-running-matlab-release))
+    (if (fboundp 'comint-read-input-ring)
+	(comint-read-input-ring t))
+    ;; Remove the scrape from our list of things to do.
+    (remove-hook 'comint-output-filter-functions
+		 'matlab-shell-version-scrape)))
+
+(defun matlab-shell-mode ()
+  "Run MATLAB as a subprocess in an Emacs buffer.
+
+This mode will allow standard Emacs shell commands/completion to occur
+with MATLAB running as an inferior process.  Additionally, this shell
+mode is integrated with `matlab-mode', a major mode for editing M
+code.
+
+> From an M file buffer:
+\\
+\\[matlab-shell-save-and-go] - Save the current M file, and run it in a \
+MATLAB shell.
+
+> From Shell mode:
+\\
+\\[matlab-shell-last-error] - find location of last MATLAB runtime error \
+in the offending M file.
+
+> From an M file, or from Shell mode:
+\\
+\\[matlab-shell-run-command] - Run COMMAND and show result in a popup buffer.
+\\[matlab-shell-describe-variable] - Show variable contents in a popup buffer.
+\\[matlab-shell-describe-command] - Show online documentation for a command \
+in a popup buffer.
+\\[matlab-shell-apropos] - Show output from LOOKFOR command in a popup buffer.
+\\[matlab-shell-topic-browser] - Topic browser using HELP.
+
+> Keymap:
+\\{matlab-mode-map}"
+  (setq major-mode 'matlab-shell-mode
+	mode-name "M-Shell"
+	comint-prompt-regexp "^\\(K\\|EDU\\)?>> *"
+	comint-delimiter-argument-list (list [ 59 ]) ; semi colon
+	comint-dynamic-complete-functions '(comint-replace-by-expanded-history)
+	comint-process-echoes matlab-shell-echoes
+	)
+  ;; matlab-shell variable setup
+  (make-local-variable 'matlab-shell-last-error-anchor)
+  (setq matlab-shell-last-error-anchor nil)
+
+  ;; Shell Setup
+  (require 'shell)
+  (if (fboundp 'shell-directory-tracker)
+      (add-hook 'comint-input-filter-functions 'shell-directory-tracker nil t)) ;; patch Eli Merriam
+  ;; Add a spiffy logo if we are running XEmacs
+  (if (and (string-match "XEmacs" emacs-version)
+	   (stringp matlab-shell-logo)
+	   (file-readable-p matlab-shell-logo))
+      (add-hook 'comint-output-filter-functions 'matlab-shell-hack-logo))
+  ;; Add a version scraping logo identification filter.
+  (add-hook 'comint-output-filter-functions 'matlab-shell-version-scrape)
+  ;; Add pseudo html-renderer
+  (add-hook 'comint-output-filter-functions 'matlab-shell-render-html-anchor nil t)
+  (add-hook 'comint-output-filter-functions 'matlab-shell-render-html-txt-format nil t)
+  (add-hook 'comint-output-filter-functions 'matlab-shell-render-errors-as-anchor nil t)
+  ;; Scroll to bottom after running cell/region
+  (add-hook 'comint-output-filter-functions 'comint-postoutput-scroll-to-bottom)
+
+  (make-local-variable 'comment-start)
+  (setq comment-start "%")
+  (use-local-map matlab-shell-mode-map)
+  (set-syntax-table matlab-mode-syntax-table)
+  (make-local-variable 'font-lock-defaults)
+  (setq font-lock-defaults '((matlab-shell-font-lock-keywords-1
+			      matlab-shell-font-lock-keywords-2
+			      matlab-shell-font-lock-keywords-3)
+			     t nil ((?_ . "w"))))
+  (set (make-local-variable 'comint-input-ring-size)
+       matlab-shell-input-ring-size)
+  (set (make-local-variable 'comint-input-ring-file-name)
+       (format matlab-shell-history-file "R12"))
+  (if (fboundp 'comint-read-input-ring)
+      (comint-read-input-ring t))
+  (make-local-variable 'gud-marker-acc)
+  (easy-menu-define
+   matlab-shell-menu
+   matlab-shell-mode-map
+   "MATLAB shell menu"
+   '("MATLAB"
+     ["Goto last error" matlab-shell-last-error t]
+     "----"
+     ["Stop On Errors" matlab-shell-dbstop-error t]
+     ["Don't Stop On Errors" matlab-shell-dbclear-error t]
+     "----"
+     ["Run Command" matlab-shell-run-command t]
+     ["Describe Variable" matlab-shell-describe-variable t]
+     ["Describe Command" matlab-shell-describe-command t]
+     ["Lookfor Command" matlab-shell-apropos t]
+     ["Topic Browser" matlab-shell-topic-browser t]
+     "----"
+     ["Demos" matlab-shell-demos t]
+     ["Close Current Figure" matlab-shell-close-current-figure t]
+     ["Close Figures" matlab-shell-close-figures t]
+     "----"
+     ["Customize" (customize-group 'matlab-shell)
+      (and (featurep 'custom) (fboundp 'custom-declare-variable))
+      ]
+     ["Exit" matlab-shell-exit t]))
+  (easy-menu-add matlab-shell-menu matlab-shell-mode-map)
+  
+  (if matlab-shell-enable-gud-flag
+      (progn
+	(gud-def gud-break  "dbstop at %l in %f"  "\C-b" "Set breakpoint at current line.")
+	(gud-def gud-remove "dbclear at %l in %f" "\C-d" "Remove breakpoint at current line")
+	(gud-def gud-step   "dbstep in"           "\C-s" "Step one source line, possibly into a function.")
+	(gud-def gud-next   "dbstep %p"           "\C-n" "Step over one source line.")
+	(gud-def gud-cont   "dbcont"              "\C-r" "Continue with display.")
+	(gud-def gud-finish "dbquit"              "\C-f" "Finish executing current function.")
+	(gud-def gud-up     "dbup %p"             "<"    "Up N stack frames (numeric arg).")
+	(gud-def gud-down   "dbdown %p"           ">"    "Down N stack frames (numeric arg).")
+	(gud-def gud-print  "%e"                  "\C-p" "Evaluate M expression at point.")
+	(if (fboundp 'gud-make-debug-menu)
+	    (gud-make-debug-menu))
+	(if (fboundp 'gud-overload-functions)
+	    (gud-overload-functions
+	     '((gud-massage-args . gud-matlab-massage-args)
+	       (gud-marker-filter . gud-matlab-marker-filter)
+	       (gud-find-file . gud-matlab-find-file))))
+	;; XEmacs doesn't seem to have this concept already.  Oh well.
+	(setq gud-marker-acc nil)
+	;; XEmacs has problems w/ this variable.  Set it here.
+	(set-marker comint-last-output-start (point-max))
+	))
+  (run-hooks 'matlab-shell-mode-hook)
+  (matlab-show-version)
+  )
+
+(defvar gud-matlab-marker-regexp-prefix "error:\\|opentoline"
+  "A prefix to scan for to know if output might be scarfed later.")
+
+(defvar matlab-shell-html-map
+  (let ((km (make-sparse-keymap)))
+    (if (string-match "XEmacs" emacs-version)
+	(define-key km [button2] 'matlab-shell-html-click)
+      (define-key km [mouse-2] 'matlab-shell-html-click))
+    (define-key km [return] 'matlab-shell-html-go)
+    km)
+  "Keymap used on overlays that represent errors.")
+
+;; ANCHORS
+(defvar matlab-anchor-beg ""
+  "Beginning of html anchor.")
+
+(defvar matlab-anchor-end ""
+  "End of html anchor.")
+
+(defun matlab-shell-render-html-anchor (str)
+  "Render html anchors inserted into the MATLAB shell buffer.
+Argument STR is the text for the anchor."
+  (if (string-match matlab-anchor-end str)
+      (save-excursion
+        (while (re-search-backward matlab-anchor-beg
+				   ;; Arbitrary back-buffer.  We don't
+				   ;; usually get text in such huge chunks
+				   (max (point-min) (- (point-max) 8192))
+				   t)
+          (let* ((anchor-beg-start (match-beginning 0))
+                 (anchor-beg-finish (match-end 0))
+                 (anchor-text (match-string 1))
+                 (anchor-end-finish (search-forward matlab-anchor-end))
+                 (anchor-end-start (match-beginning 0))
+                 (o (matlab-make-overlay anchor-beg-finish anchor-end-start)))
+            (matlab-overlay-put o 'mouse-face 'highlight)
+            (matlab-overlay-put o 'face 'underline)
+            (matlab-overlay-put o 'matlab-url anchor-text)
+            (matlab-overlay-put o 'keymap matlab-shell-html-map)
+	    (matlab-overlay-put o 'help-echo anchor-text)
+            (delete-region anchor-end-start anchor-end-finish)
+            (delete-region anchor-beg-start anchor-beg-finish)
+            ))))
+  )
+
+;; TEXT FORMATTING
+(defvar matlab-txt-format-beg "<\\(strong\\|u\\)>"
+  "Beginning of html text formatting signal in HTML.")
+
+(defvar matlab-txt-format-end ""
+  "End of some html text formatter.
+Includes a %s to match the kind of text format start regexp.")
+
+(defun matlab-shell-render-html-txt-format (str)
+  "Render html text format inserted into the MATLAB shell buffer.
+Argument STR is the text for the text formater."
+  (if (string-match "" str)
+      (save-excursion
+        (while (re-search-backward matlab-txt-format-beg
+				   ;; Arbitrary back-buffer.  We don't
+				   ;; usually get text in such huge chunks
+				   (max (point-min) (- (point-max) 8192))
+				   t)
+          (let* ((txt-format-beg-start (match-beginning 0))
+                 (txt-format-beg-finish (match-end 0))
+                 (txt-format-text (match-string 1))
+                 (txt-format-end-finish
+		  ;; The finish combines the text from the start to get an
+		  ;; exact match.
+		  (search-forward (format matlab-txt-format-end txt-format-text)))
+                 (txt-format-end-start (match-beginning 0))
+                 (o (matlab-make-overlay txt-format-beg-finish txt-format-end-start)))
+	    (cond ((string= txt-format-text "strong")
+		   (upcase-region txt-format-beg-finish txt-format-end-start)
+		   (matlab-overlay-put o 'face 'bold))
+		  ((string= txt-format-text "u")
+		   (matlab-overlay-put o 'face 'underline))
+		  (t
+		   ;; If we don't match, delete the overlay instead.
+		   (matlab-delete-overlay o)
+		   (setq o nil)
+		   ))
+	    (when o
+	      (delete-region txt-format-end-start txt-format-end-finish)
+	      (delete-region txt-format-beg-start txt-format-beg-finish))
+            ))))
+  )
+
+;; The regular expression covers the following form:
+;; Errors:  Error in ==> 
+;;          On line # ==> 
+;; Errors:  Error using ==>  at <#>
+;; Syntax:  Syntax error in ==> 
+;;          On line # ==> 
+;; Warning: In  at line # 
+(defvar gud-matlab-error-regexp
+  (concat "\\(Error \\(?:in\\|using\\) ==>\\|Syntax error in ==>\\|In\\) "
+	  "\\([-@.a-zA-Z_0-9/ \\\\:]+\\)\\(?:>[^ ]+\\)?.*[\n ]\\(?:On\\|at\\)\\(?: line\\)? "
+	  "\\([0-9]+\\) ?")
+  "Regular expression finding where an error occurred.")
+
+(defvar matlab-shell-last-error-anchor nil
+  "Last point where an error anchor was set.")
+(defvar matlab-shell-last-anchor-as-frame nil
+  ;; NOTE: this isn't being used yet.
+  "The last error anchor saved, represented as a debugger frame.")
+
+(defun matlab-shell-render-errors-as-anchor (str)
+  "Detect non-url errors, and treat them as if they were url anchors.
+Argument STR is the text that might have errors in it."
+  (save-excursion
+    ;; We have found an error stack to investigate.
+    (let ((first nil)
+	  (overlaystack nil))
+      (while (re-search-backward gud-matlab-error-regexp
+				 (if matlab-shell-last-error-anchor
+				     (min matlab-shell-last-error-anchor (point))
+				   (point))
+				 t)
+	(let* ((err-start (match-beginning 0))
+	       (err-end (match-end 0))
+	       (err-text (match-string 0))
+	       (err-file (match-string 2))
+	       (err-line (match-string 3))
+	       (o (matlab-make-overlay err-start err-end))
+	       (url (concat "opentoline('" err-file "'," err-line ",0)"))
+	       )
+	  (matlab-overlay-put o 'mouse-face 'highlight)
+	  (matlab-overlay-put o 'face 'underline)
+	  ;; The url will recycle opentoline code.
+	  (matlab-overlay-put o 'matlab-url url)
+	  (matlab-overlay-put o 'keymap matlab-shell-html-map)
+	  (matlab-overlay-put o 'help-echo (concat "Jump to error at " err-file "."))
+	  (setq first url)
+	  (push o overlaystack)
+	  ;; Save as a frame
+	  (setq matlab-shell-last-anchor-as-frame
+		(cons err-file err-line))
+	  ))
+      ;; Keep track of the very first error in this error stack.
+      ;; It will represent the "place to go" for "go-to-last-error".
+      (dolist (O overlaystack)
+	(matlab-overlay-put O 'first-in-error-stack first))
+      ;; Once we've found something, don't scan it again.
+      (setq matlab-shell-last-error-anchor (point-marker)))))
+
+(defvar gud-matlab-marker-regexp-1 "^K>>"
+  "Regular expression for finding a file line-number.")
+
+(defvar gud-matlab-marker-regexp-2
+  (concat "^> In \\(" matlab-anchor-beg
+          "\\|\\)\\([-.a-zA-Z0-9_>/@]+\\) \\((\\w+) \\|\\)at line \\([0-9]+\\)[ \n]+")
+  "Regular expression for finding a file line-number.
+Please note: The leading > character represents the current stack frame, so if
+there are several frames, this makes sure we pick the right one to popup.")
+
+(defun gud-matlab-massage-args (file args)
+  "Argument massager for starting matlab file.
+I don't think I have to do anything, but I'm not sure.
+FILE is ignored, and ARGS is returned."
+  args)
+
+(defun gud-matlab-marker-filter (string)
+  "Filters STRING for the Unified Debugger based on MATLAB output."
+  (if matlab-prompt-seen
+      nil
+    (when (string-match ">> " string)
+      (if matlab-shell-use-emacs-toolbox
+	  ;; Use our local toolbox directory.
+	  (process-send-string
+	   (get-buffer-process gud-comint-buffer)
+	   (format "addpath('%s','-begin'); rehash; emacsinit('%s');\n"
+		   (expand-file-name "toolbox"
+				     (file-name-directory
+				      (locate-library "matlab")))
+		   matlab-shell-emacsclient-command))
+	;; User doesn't want to use our fancy toolbox directory
+	(process-send-string
+	 (get-buffer-process gud-comint-buffer)
+	 "if usejava('jvm'), \
+com.mathworks.services.Prefs.setBooleanPref('EditorGraphicalDebugging', false); \
+end\n"
+	 ))
+      ;; Mark that we've seen at least one prompt.
+      (setq matlab-prompt-seen t)
+      ))
+  (let ((garbage (concat "\\(" (regexp-quote "\C-g") "\\|"
+ 			 (regexp-quote "\033[H0") "\\|"
+ 			 (regexp-quote "\033[H\033[2J") "\\|"
+ 			 (regexp-quote "\033H\033[2J") "\\)")))
+    (while (string-match garbage string)
+      (if (= (aref string (match-beginning 0)) ?\C-g)
+	  (beep t))
+      (setq string (replace-match "" t t string))))
+
+  (setq gud-marker-acc (concat gud-marker-acc string))
+  (let ((output "") (frame nil))
+
+    (when (not frame)
+      (when (string-match gud-matlab-marker-regexp-1 gud-marker-acc)
+	(when (not frame)
+	  ;; If there is a debug prompt, and no frame currently set,
+	  ;; go find one.
+	  (let ((url gud-marker-acc)
+		ef el)
+	    (cond
+	     ((string-match "^error:\\(.*\\),\\([0-9]+\\),\\([0-9]+\\)$" url)
+	      (setq ef (substring url (match-beginning 1) (match-end 1))
+		    el (substring url (match-beginning 2) (match-end 2)))
+	      )
+	     ((string-match "opentoline('\\([^']+\\)',\\([0-9]+\\),\\([0-9]+\\))" url)
+	      (setq ef (substring url (match-beginning 1) (match-end 1))
+		    el (substring url (match-beginning 2) (match-end 2)))
+	      )
+	     ;; If we have the prompt, but no match (as above),
+	     ;; perhaps it is already dumped out into the buffer.  In
+	     ;; that case, look back through the buffer.
+	     
+	     )
+	    (when ef
+	      (setq frame (cons ef (string-to-number el)))))))
+      )
+    ;; This if makes sure that the entirety of an error output is brought in
+    ;; so that matlab-shell-mode doesn't try to display a file that only partially
+    ;; exists in the buffer.  Thus, if MATLAB output:
+    ;;  error: /home/me/my/mo/mello.m,10,12
+    ;; All of that is in the buffer, and it goes to mello.m, not just
+    ;; the first half of that file name.
+    ;; The below used to match against the prompt, not \n, but then text that
+    ;; had error: in it for some other reason wouldn't display at all.
+    (if (and matlab-prompt-seen ;; Don't collect during boot
+	     (not frame) ;; don't collect debug stuff
+	     (let ((start (string-match gud-matlab-marker-regexp-prefix gud-marker-acc)))
+	       (and start
+		    (not (string-match "\n" gud-marker-acc start))
+		    ;;(not (string-match "^K?>>\\|\\?\\?\\?\\s-Error while evaluating" gud-marker-acc start))
+		    )))
+	;; We could be collecting something.  Wait for a while.
+	nil
+      ;; Finish off this part of the output.  None of our special stuff
+      ;; ends with a \n, so display those as they show up...
+      (while (string-match "^[^\n]*\n" gud-marker-acc)
+	(setq output (concat output (substring gud-marker-acc 0 (match-end 0)))
+	      gud-marker-acc (substring gud-marker-acc (match-end 0))))
+
+      (setq output (concat output gud-marker-acc)
+	  gud-marker-acc "")
+      ;; Check our output for a prompt, and existence of a frame.
+      ;; If t his is true, throw out the debug arrow stuff.
+      (if (and (string-match "^>> $" output)
+	       gud-last-last-frame)
+	  (progn
+	    (setq overlay-arrow-position nil
+		  gud-last-last-frame nil
+		  gud-overlay-arrow-position nil)
+	    (sit-for 0)
+	    )))
+
+    (if frame (setq gud-last-frame frame))
+
+    ;;(message "[%s] [%s]" output gud-marker-acc)
+
+    output))
+
+(defun gud-matlab-find-file (f)
+  "Find file F when debugging frames in MATLAB."
+  (save-excursion
+    (let* ((realfname (if (string-match "\\.\\(p\\)$" f)
+			  (progn
+			    (aset f (match-beginning 1) ?m)
+			    f)
+			f))
+	   (buf (find-file-noselect realfname)))
+      (set-buffer buf)
+      (if (fboundp 'gud-make-debug-menu)
+	  (gud-make-debug-menu))
+      buf)))
+
+(defun matlab-shell-next-matching-input-from-input (n)
+  "Get the Nth next matching input from for the command line."
+  (interactive "p")
+  (matlab-shell-previous-matching-input-from-input (- n)))
+
+(defun matlab-shell-previous-matching-input-from-input (n)
+  "Get the Nth previous matching input from for the command line."
+  (interactive "p")
+  (end-of-line) ;; patch: Mark Histed
+  (if (comint-after-pmark-p)
+      (if (memq last-command '(matlab-shell-previous-matching-input-from-input
+			       matlab-shell-next-matching-input-from-input))
+	  ;; This hack keeps the cycling working well.
+	  (let ((last-command 'comint-previous-matching-input-from-input))
+	    (comint-next-matching-input-from-input (- n)))
+	;; first time.
+	(comint-next-matching-input-from-input (- n)))
+
+    ;; If somewhere else, just move around.
+    (previous-line n)))
+
+(defun matlab-shell-delete-backwards-no-prompt (&optional arg)
+  "Delete one char backwards without destroying the matlab prompt.
+Optional argument ARG describes the number of chars to delete."
+  (interactive "P")
+  (let ((promptend (save-excursion
+		     (beginning-of-line)
+		     (if (looking-at "K?>> ")
+			 (match-end 0)
+		       (point))))
+	(numchars (if (integerp arg) (- arg) -1)))
+    (if (<= promptend (+ (point) numchars))
+	(delete-char numchars)
+      (error "Beginning of line"))))
+
+(defun matlab-shell-completion-list (str)
+  "Get a list of completions from MATLAB.
+STR is a substring to complete."
+  (save-excursion
+    (let* ((msbn (matlab-shell-buffer-barf-not-running))
+	   (cmd (concat "matlabMCRprocess = com.mathworks.jmi.MatlabMCR;"
+			"matlabMCRprocess.mtFindAllTabCompletions('"
+			str "'), clear('matlabMCRprocess');"))
+	   (comint-scroll-show-maximum-output nil)
+	   output
+	   (completions nil))
+      (set-buffer msbn)
+      (if (not (matlab-on-prompt-p))
+	  (error "MATLAB shell must be non-busy to do that"))
+      (setq output (matlab-shell-collect-command-output cmd))
+      ;; Debug
+      (string-match "ans =" output)
+      (setq output (substring output (match-end 0)))
+      ;; Parse the output string.
+      (while (string-match "'" output)
+	;; Hack off the preceeding quote
+	(setq output (substring output (match-end 0)))
+	(string-match "'" output)
+	;; we are making a completion list, so that is a list of lists.
+	(setq completions (cons (list (substring output 0 (match-beginning 0)))
+				completions)
+	      output (substring output (match-end 0))))
+      ;; Return them
+      (nreverse completions))))
+
+(defun matlab-shell-which-fcn (fcn)
+  "Get the location of FCN's M file.
+Returns an alist: ( LOCATION . BUILTINFLAG )
+LOCATION is a string indicating where it is, and BUILTINFLAG is
+non-nil if FCN is a builtin."
+  (save-excursion
+    (let* ((msbn (matlab-shell-buffer-barf-not-running))
+	   (cmd (concat "which " fcn))
+	   (comint-scroll-show-maximum-output nil)
+	   output
+	   builtin
+	   )
+      (set-buffer msbn)
+      (if (not (matlab-on-prompt-p))
+	  (error "MATLAB shell must be non-busy to do that"))
+      (setq output (matlab-shell-collect-command-output cmd))
+      ;; BUILT-IN
+      (cond
+       ((string-match "built-in (\\([^)]+\\))" output)
+	(cons (concat (substring output (match-beginning 1) (match-end 1))
+		      ".m")
+	      t))
+       ;; Error
+       ((string-match "not found" output)
+	nil)
+       ;; JUST AN M FILE
+       (t
+	(string-match "$" output)
+	(cons (substring output 0 (match-beginning 0)) nil))))))
+
+(defun matlab-shell-matlabroot ()
+  "Get the location of of this shell's root.
+Returns a string path to the root of the executing MATLAB."
+  (save-excursion
+    (let* ((msbn (matlab-shell-buffer-barf-not-running))
+	   (cmd "disp(matlabroot)")
+	   (comint-scroll-show-maximum-output nil)
+	   output
+	   builtin
+	   )
+      (set-buffer msbn)
+
+      (if (and (boundp 'matlab-shell-matlabroot-run)
+	       matlab-shell-matlabroot-run)
+	  matlab-shell-matlabroot-run
+	;; If we haven't cache'd it, calculate it now.
+
+	(if (not (matlab-on-prompt-p))
+	    (error "MATLAB shell must be non-busy to do that"))
+	(setq output (matlab-shell-collect-command-output cmd))
+	
+	(string-match "$" output)
+	(substring output 0 (match-beginning 0))))))
+
+(defvar matlab-shell-window-exists-for-display-completion-flag nil
+  "Non-nil means there was an 'other-window' available when `display-completion-list' is called.")
+
+(defun matlab-shell-tab ()
+   "Send [TAB] to the currently running matlab process and retrieve completion."
+   (interactive)
+   (if (not matlab-shell-ask-MATLAB-for-completions)
+       (call-interactively 'comint-dynamic-complete-filename)
+     (if (not (matlab-on-prompt-p))
+	 (error "Completions not available"))
+     (if nil
+	 ;; For older versions of MATLAB that don't have TAB
+	 ;; completion.
+	 (call-interactively 'comint-dynamic-complete-filename)
+       ;; Save the old command
+       (goto-char (point-max))
+       (let ((inhibit-field-text-motion t))
+	 (beginning-of-line))
+       (re-search-forward comint-prompt-regexp)
+       (let* ((lastcmd (buffer-substring (point) (matlab-point-at-eol)))
+	      (tempcmd lastcmd)
+	      (completions nil)
+	      (limitpos nil))
+	 ;; search for character which limits completion, and limit command to it
+	 (setq limitpos
+	       (if (string-match ".*\\([( /[.,;=']\\)" lastcmd)
+		   (1+ (match-beginning 1))
+		 0))
+	 (setq lastcmd (substring lastcmd limitpos))
+	 ;; Whack the old command so we can insert it back later.
+	 (delete-region (+ (point) limitpos) (matlab-point-at-eol))
+	 ;; double every single quote
+	 (while (string-match "[^']\\('\\)\\($\\|[^']\\)" tempcmd)
+	   (setq tempcmd (replace-match "''" t t tempcmd 1)))
+	 ;; collect the list
+	 (setq completions (matlab-shell-completion-list tempcmd))
+	 (goto-char (point-max))
+	 (if (eq (length completions) 1)
+	     ;; If there is only one, then there is an obvious thing to do.
+	     (progn
+	       (insert (car (car completions)))
+	       ;; kill completions buffer if still visible
+	       (matlab-shell-tab-hide-completions))
+	   (let ((try (try-completion lastcmd completions)))
+	     ;; Insert in a good completion.
+	     (cond ((or (eq try nil) (eq try t)
+			(and (stringp try)
+			     (string= try lastcmd)))
+		    (insert lastcmd)
+		    ;; Before displaying the completions buffer, check to see if
+		    ;; the completions window is already displayed, or if there is
+		    ;; a next window to display.  This determines how to remove the
+		    ;; completions later.
+		    (if (get-buffer-window "*Completions*")
+			nil ;; Recycle old value of the display flag.
+		      ;; Else, reset this variable.
+		      (setq matlab-shell-window-exists-for-display-completion-flag
+			    ;; Else, it isn't displayed, save an action.
+			    (if (eq (next-window) (selected-window))
+				;; If there is no other window, the post action is
+				;; to delete.
+				'delete
+			      ;; If there is a window to display, the post
+			      ;; action is to bury.
+			      'bury)))
+		    (with-output-to-temp-buffer "*Completions*"
+		      (display-completion-list (mapcar 'car completions) lastcmd)))
+		   ((stringp try)
+		    (insert try)
+		    (matlab-shell-tab-hide-completions))
+		   (t
+		    (insert lastcmd))))
+	   )))))
+
+(defun matlab-shell-tab-hide-completions ()
+  "Hide any completion windows for `matlab-shell-tab'."
+  (cond ((eq matlab-shell-window-exists-for-display-completion-flag 'delete)
+	 (when (get-buffer "*Completions*")
+	   (delete-windows-on "*Completions*")))
+	((eq matlab-shell-window-exists-for-display-completion-flag 'bury)
+	 (let ((orig (selected-window))
+	       (bw nil))
+	   (while (setq bw (get-buffer-window "*Completions*"))
+	     (select-window bw)
+	     (bury-buffer))
+	   (select-window orig)))
+	)
+  ;; Reset state.
+  (setq matlab-shell-window-exists-for-display-completion-flag nil))
+
+
+;;; MATLAB mode Shell commands ================================================
+
+(defun matlab-show-matlab-shell-buffer ()
+  "Switch to the buffer containing the matlab process."
+  (interactive)
+  (let ((msbn (concat "*" matlab-shell-buffer-name "*")))
+    (if (get-buffer msbn)
+	(switch-to-buffer-other-window msbn)
+      (message "There is not an active MATLAB process."))))
+
+(defvar matlab-shell-save-and-go-history '("()")
+  "Keep track of parameters passed to the MATLAB shell.")
+
+(defun matlab-shell-add-to-input-history (string)
+  "Add STRING to the input-ring and run `comint-input-filter-functions' on it.
+Similar to  `comint-send-input'."
+  (if (and (funcall comint-input-filter string)
+	   (or (null comint-input-ignoredups)
+	       (not (ring-p comint-input-ring))
+	       (ring-empty-p comint-input-ring)
+	       (not (string-equal (ring-ref comint-input-ring 0) string))))
+      (ring-insert comint-input-ring string))
+  (run-hook-with-args 'comint-input-filter-functions
+		      (concat string "\n"))
+  (if (boundp 'comint-save-input-ring-index);only bound in GNU emacs
+      (setq comint-save-input-ring-index comint-input-ring-index))
+  (setq comint-input-ring-index nil))
+
+(defun matlab-shell-save-and-go ()
+  "Save this M file, and evaluate it in a MATLAB shell."
+  (interactive)
+  (if (not (eq major-mode 'matlab-mode))
+      (error "Save and go is only useful in a MATLAB buffer!"))
+  (if (not (buffer-file-name (current-buffer)))
+      (call-interactively 'write-file))
+  (let ((fn-name (file-name-sans-extension
+		  (file-name-nondirectory (buffer-file-name))))
+	(msbn (concat "*" matlab-shell-buffer-name "*"))
+	(param ""))
+    (save-buffer)
+    ;; Do we need parameters?
+    (if (save-excursion
+	  (goto-char (point-min))
+	  (end-of-line)
+	  (forward-sexp -1)
+	  (looking-at "([a-zA-Z]"))
+	(setq param (read-string "Parameters: "
+				 (car matlab-shell-save-and-go-history)
+				 'matlab-shell-save-and-go-history)))
+    (if (matlab-with-emacs-link)
+	;; Execute the current file in MATLAB
+	(matlab-eei-run)
+
+      ;; No buffer?  Make it!
+      (if (not (get-buffer msbn)) (matlab-shell))
+      ;; Ok, now fun the function in the matlab shell
+      (if (get-buffer-window msbn t)
+	  (select-window (get-buffer-window msbn t))
+	(switch-to-buffer (concat "*" matlab-shell-buffer-name "*")))
+
+      (let ((cmd (concat fn-name " " param)))
+	(matlab-shell-add-to-input-history cmd)
+	(matlab-shell-send-string (concat cmd "\n"))))))
+
+(defun matlab-shell-run-region (beg end &optional noshow)
+  "Run region from BEG to END and display result in MATLAB shell.
+If NOSHOW is non-nil, replace newlines with commas to suppress output.
+This command requires an active MATLAB shell."
+  (interactive "r")
+  (if (> beg end) (let (mid) (setq mid beg beg end end mid)))
+
+  (let ((command
+	 (let ((str (concat (buffer-substring beg end) "\n")))
+	   ;; Remove comments
+	   (with-temp-buffer
+	     (insert str)
+	     (goto-char (point-min))
+	     (while (search-forward "%" nil t)
+	       (when (not (matlab-cursor-in-string))
+		 (delete-region (1- (point)) (matlab-point-at-eol))))
+	     (setq str (buffer-substring-no-properties (point-min) (point-max))))
+	   (while (string-match "\n\\s-*\n" str)
+	     (setq str (concat (substring str 0 (match-beginning 0))
+			       "\n"
+			       (substring str (match-end 0)))))
+	   (when noshow
+	     ;; Remove continuations
+	     (while (string-match
+		     (concat "\\s-*"
+			     (regexp-quote matlab-elipsis-string)
+			     "\\s-*\n")
+		     str)
+	       (setq str (replace-match " " t t str)))
+	     (while (string-match "\n" str)
+	       (setq str (replace-match ", " t t str)))
+	     (setq str (concat str "\n")))
+	   str))
+ 	(msbn nil)
+ 	(lastcmd)
+	(inhibit-field-text-motion t))
+    (if (matlab-with-emacs-link)
+	;; Run the region w/ Emacs Link
+	(matlab-eei-eval-region beg end)
+
+      (save-excursion
+	(setq msbn (matlab-shell-buffer-barf-not-running))
+	(set-buffer msbn)
+	(if (not (matlab-on-prompt-p))
+	    (error "MATLAB shell must be non-busy to do that"))
+	;; Save the old command
+	(beginning-of-line)
+	(re-search-forward comint-prompt-regexp)
+	(setq lastcmd (buffer-substring (point) (matlab-point-at-eol)))
+	(delete-region (point) (matlab-point-at-eol))
+	;; We are done error checking, run the command.
+	(matlab-shell-send-string command)
+	(insert lastcmd))
+      (set-buffer msbn)
+      (goto-char (point-max))
+      (display-buffer msbn nil "visible"))
+    ))
+
+(defun matlab-shell-run-cell ()
+  "Run the cell the cursor is in."
+  (interactive)
+  (let ((start (save-excursion (forward-page -1)
+			       (if (looking-at "function")
+				   (error "You are not in a cell.  Try `matlab-shell-save-and-go' instead"))
+			       (when (matlab-ltype-comm)
+				 ;; Skip over starting comment from the current cell.
+				 (matlab-end-of-command 1)
+				 (end-of-line)
+				 (forward-char 1))
+			       (point)))
+	(end (save-excursion (forward-page 1)
+			     (when (matlab-ltype-comm)
+			       (beginning-of-line)
+			       (forward-char -1))
+			     (point))))
+    (matlab-shell-run-region start end t)))
+
+(defun matlab-shell-run-region-or-line ()
+  "Run region from BEG to END and display result in MATLAB shell.
+pIf region is not active run the current line.
+This command requires an active MATLAB shell."
+  (interactive)
+ (if (and transient-mark-mode mark-active)
+     (matlab-shell-run-region (mark) (point))
+   (matlab-shell-run-region (matlab-point-at-bol) (matlab-point-at-eol))))
+ 
+
+;;; MATLAB Shell Commands =====================================================
+
+(defun matlab-read-word-at-point ()
+  "Get the word closest to point, but do not change position.
+Has a preference for looking backward when not directly on a symbol.
+Snatched and hacked from dired-x.el"
+  (let ((word-chars "a-zA-Z0-9_")
+	(bol (matlab-point-at-bol))
+	(eol (matlab-point-at-eol))
+        start)
+    (save-excursion
+      ;; First see if just past a word.
+      (if (looking-at (concat "[" word-chars "]"))
+	  nil
+	(skip-chars-backward (concat "^" word-chars "{}()\[\]") bol)
+	(if (not (bobp)) (backward-char 1)))
+      (if (numberp (string-match (concat "[" word-chars "]")
+				 (char-to-string (following-char))))
+          (progn
+            (skip-chars-backward word-chars bol)
+            (setq start (point))
+            (skip-chars-forward word-chars eol))
+        (setq start (point)))		; If no found, return empty string
+      (buffer-substring start (point)))))
+
+(defun matlab-read-line-at-point ()
+  "Get the line under point, if command line."
+  (if (eq major-mode 'matlab-shell-mode)
+      (save-excursion
+	(let ((inhibit-field-text-motion t))
+	  (beginning-of-line)
+	  (if (not (looking-at (concat comint-prompt-regexp)))
+	      ""
+	    (search-forward-regexp comint-prompt-regexp)
+	    (buffer-substring (point) (matlab-point-at-eol)))))
+    (save-excursion
+      ;; In matlab buffer, find all the text for a command.
+      ;; so back over until there is no more continuation.
+      (while (save-excursion (forward-line -1) (matlab-lattr-cont))
+	(forward-line -1))
+      ;; Go forward till there is no continuation
+      (beginning-of-line)
+      (let ((start (point)))
+	(while (matlab-lattr-cont) (forward-line 1))
+	(end-of-line)
+	(buffer-substring start (point))))))
+
+(defun matlab-non-empty-lines-in-string (str)
+  "Return number of non-empty lines in STR."
+  (let ((count 0)
+	(start 0))
+    (while (string-match "^.+$" str start)
+      (setq count (1+ count)
+	    start (match-end 0)))
+    count))
+
+(defun matlab-output-to-temp-buffer (buffer output)
+  "Print output to temp buffer, or a message if empty string.
+BUFFER is the buffer to output to, and OUTPUT is the text to insert."
+  (let ((lines-found (matlab-non-empty-lines-in-string output)))
+    (cond ((= lines-found 0)
+	   (message "(MATLAB command completed with no output)"))
+	  ((= lines-found 1)
+	   (string-match "^.+$" output)
+	   (message (substring output (match-beginning 0)(match-end 0))))
+	  (t (with-output-to-temp-buffer buffer (princ output))
+	     (save-excursion
+	       (set-buffer buffer)
+	       (matlab-shell-help-mode))))))
+
+(defun matlab-shell-run-command (command)
+  "Run COMMAND and display result in a buffer.
+This command requires an active MATLAB shell."
+  (interactive (list (read-from-minibuffer
+ 		      "MATLAB command line: "
+ 		      (cons (matlab-read-line-at-point) 0))))
+  (let ((doc (matlab-shell-collect-command-output command)))
+    (matlab-output-to-temp-buffer "*MATLAB Help*" doc)))
+
+(defun matlab-shell-describe-variable (variable)
+  "Get the contents of VARIABLE and display them in a buffer.
+This uses the WHOS (MATLAB 5) command to find viable commands.
+This command requires an active MATLAB shell."
+  (interactive (list (read-from-minibuffer
+ 		      "MATLAB variable: "
+ 		      (cons (matlab-read-word-at-point) 0))))
+  (let ((doc (matlab-shell-collect-command-output (concat "whos " variable))))
+    (matlab-output-to-temp-buffer "*MATLAB Help*" doc)))
+
+(defun matlab-shell-describe-command (command)
+  "Describe COMMAND textually by fetching it's doc from the MATLAB shell.
+This uses the lookfor command to find viable commands.
+This command requires an active MATLAB shell."
+  (interactive
+   (let ((fn (matlab-function-called-at-point))
+	 val)
+     (setq val (read-string (if fn
+				(format "Describe function (default %s): " fn)
+			      "Describe function: ")))
+     (if (string= val "") (list fn) (list val))))
+  (let ((doc (matlab-shell-collect-command-output (concat "help " command))))
+    (matlab-output-to-temp-buffer "*MATLAB Help*" doc)))
+
+(defun matlab-shell-apropos (matlabregex)
+  "Look for any active commands in MATLAB matching MATLABREGEX.
+This uses the lookfor command to find viable commands."
+  (interactive (list (read-from-minibuffer
+ 		      "MATLAB command subexpression: "
+ 		      (cons (matlab-read-word-at-point) 0))))
+  (let ((ap (matlab-shell-collect-command-output
+	     (concat "lookfor " matlabregex))))
+    (matlab-output-to-temp-buffer "*MATLAB Apropos*" ap)))
+  
+(defun matlab-on-prompt-p ()
+  "Return t if we MATLAB can accept input."
+  (save-excursion
+    (let ((inhibit-field-text-motion t))
+      (goto-char (point-max))
+      (beginning-of-line)
+      (looking-at comint-prompt-regexp))))
+
+(defun matlab-on-empty-prompt-p ()
+  "Return t if we MATLAB is on an empty prompt."
+  (save-excursion
+    (let ((inhibit-field-text-motion t))
+      (goto-char (point-max))
+      (beginning-of-line)
+      (looking-at (concat comint-prompt-regexp "\\s-*$")))))
+
+(defun matlab-shell-buffer-barf-not-running ()
+  "Return a running MATLAB buffer iff it is currently active."
+  (or (matlab-shell-active-p)
+      (error "You need to run the command `matlab-shell' to do that!")))
+
+(defun matlab-shell-collect-command-output (command)
+  "If there is a MATLAB shell, run the MATLAB COMMAND and return it's output.
+It's output is returned as a string with no face properties.  The text output
+of the command is removed from the MATLAB buffer so there will be no
+indication that it ran."
+  (let ((msbn (matlab-shell-buffer-barf-not-running))
+	(pos nil)
+	(str nil)
+	(lastcmd)
+	(inhibit-field-text-motion t))
+    (save-excursion
+      (set-buffer msbn)
+      (if (not (matlab-on-prompt-p))
+	  (error "MATLAB shell must be non-busy to do that"))
+      ;; Save the old command
+      (goto-char (point-max))
+      (beginning-of-line)
+      (re-search-forward comint-prompt-regexp)
+      (setq lastcmd (buffer-substring (point) (matlab-point-at-eol)))
+      (delete-region (point) (matlab-point-at-eol))
+      ;; We are done error checking, run the command.
+      (setq pos (point))
+      (comint-simple-send (get-buffer-process (current-buffer))
+			  (concat command "\n"))
+      ;;(message "MATLAB ... Executing command.")
+      (goto-char (point-max))
+      (while (or (>= (+ pos (string-width command)) (point)) (not (matlab-on-empty-prompt-p)))
+	(accept-process-output (get-buffer-process (current-buffer)))
+	(goto-char (point-max))
+	;;(message "MATLAB reading...")
+	)
+      ;;(message "MATLAB reading...done")
+      (save-excursion
+	(goto-char pos)
+	(beginning-of-line)
+	(setq str (buffer-substring-no-properties (save-excursion
+						    (goto-char pos)
+						    (beginning-of-line)
+						    (forward-line 1)
+						    (point))
+						  (save-excursion
+						    (goto-char (point-max))
+						    (beginning-of-line)
+						    (point))))
+	(delete-region pos (point-max)))
+      (insert lastcmd))
+    str))
+
+(defun matlab-shell-send-string (string)
+  "Send STRING to the currently running matlab process."
+  (if (not matlab-shell-echoes)
+      (let ((proc (get-buffer-process (current-buffer))))
+	(goto-char (point-max))
+	(insert string)
+	(set-marker (process-mark proc) (point))))
+  (comint-send-string (get-buffer-process (current-buffer)) string))
+
+(defun matlab-url-at (p)
+  "Return the matlab-url overlay at P, or nil."
+  (let ((url nil) (o (matlab-overlays-at p)))
+    (while (and o (not url))
+      (setq url (matlab-overlay-get (car o) 'matlab-url)
+            o (cdr o)))
+    url))
+
+(defun matlab-url-stack-top-at (p)
+  "Return the matlab-url overlay at P, or nil."
+  (let ((url nil) (o (matlab-overlays-at p)))
+    (while (and o (not url))
+      (setq url (or (matlab-overlay-get (car o) 'first-in-error-stack)
+		    (matlab-overlay-get (car o) 'matlab-url))
+            o (cdr o)))
+    url))
+
+(defun matlab-shell-previous-matlab-url (&optional stacktop)
+  "Find a previous occurrence of an overlay with a MATLAB URL.
+If STACKTOP is non-nil, then also get the top of some stack, which didn't
+show up in reverse order."
+  (save-excursion
+    (let ((url nil) (o nil) (p (point)))
+      (while (and (not url)
+                  (setq p (matlab-previous-overlay-change p))
+                  (not (eq p (point-min))))
+        (setq url 
+	      (if stacktop
+		  (matlab-url-stack-top-at p)
+		(matlab-url-at p))))
+      url)))
+
+(defun matlab-find-other-window-file-line-column (ef el ec &optional debug)
+  "Find file EF in other window and to go line EL and 1-basec column EC.
+If DEBUG is non-nil, then setup GUD debugging features."
+  (cond ((file-exists-p ef)
+	 nil);; keep ef the same
+	((file-exists-p (concat ef ".m"))
+	 (setq ef (concat ef ".m"))) ;; Displayed w/out .m?
+	((string-match ">" ef)
+	 (setq ef (concat (substring ef 0 (match-beginning 0)) ".m")))
+	)
+  (find-file-other-window ef)
+  (goto-line (string-to-number el))
+  (when debug
+    (setq gud-last-frame (cons (buffer-file-name) (string-to-number el)))
+    (gud-display-frame))
+  (setq ec (string-to-number ec))
+  (if (> ec 0) (forward-char (1- ec))))
+
+(defun matlab-find-other-window-via-url (url &optional debug)
+  "Find other window using matlab URL and optionally set DEBUG cursor."
+  (cond ((string-match "^error:\\(.*\\),\\([0-9]+\\),\\([0-9]+\\)$" url)
+         (let ((ef (substring url (match-beginning 1) (match-end 1)))
+               (el (substring url (match-beginning 2) (match-end 2)))
+               (ec (substring url (match-beginning 3) (match-end 3))))
+           (matlab-find-other-window-file-line-column ef el ec debug)))
+	((string-match "opentoline('\\([^']+\\)',\\([0-9]+\\),\\([0-9]+\\))" url)
+         (let ((ef (substring url (match-beginning 1) (match-end 1)))
+               (el (substring url (match-beginning 2) (match-end 2)))
+               (ec (substring url (match-beginning 3) (match-end 3))))
+           (matlab-find-other-window-file-line-column ef el ec debug)))
+        ((string-match "^matlab: *\\(.*\\)$" url)
+         (process-send-string
+          (get-buffer-process gud-comint-buffer)
+          (concat (substring url (match-beginning 1) (match-end 1)) "\n")))))
+
+(defun matlab-shell-last-error ()
+  "In the MATLAB interactive buffer, find the last MATLAB error, and go there.
+To reference old errors, put the cursor just after the error text."
+  (interactive)
+  (catch 'done
+    (let ((url (matlab-shell-previous-matlab-url t)))
+      (if url
+          (progn (matlab-find-other-window-via-url url) (throw 'done nil))
+        (save-excursion
+          (end-of-line) ;; In case we are before the linenumber 1998/06/05 16:54sk
+          (if (not (re-search-backward gud-matlab-error-regexp nil t))
+              (error "No errors found!"))
+          (let ((ef (buffer-substring-no-properties
+                     (match-beginning 2) (match-end 2)))
+                (el (buffer-substring-no-properties
+                     (match-beginning 3) (match-end 3))))
+            (matlab-find-other-window-file-line-column ef el "0")))))))
+
+(defun matlab-shell-html-click (e)
+  "Go to the error at the location of event E."
+  (interactive "e")
+  (mouse-set-point e)
+  (matlab-shell-html-go))
+
+(defun matlab-shell-html-go ()
+  "Go to the error at the location `point'."
+  (interactive)
+  (let ((url (matlab-url-at (point))))
+    (if url (matlab-find-other-window-via-url url))))
+
+(defun matlab-shell-dbstop-error ()
+  "Stop on errors."
+  (interactive)
+  (comint-send-string (get-buffer-process (current-buffer))
+		      "dbstop if error\n"))
+
+(defun matlab-shell-dbclear-error ()
+  "Don't stop on errors."
+  (interactive)
+  (comint-send-string (get-buffer-process (current-buffer))
+		      "dbclear if error\n"))
+
+(defun matlab-shell-demos ()
+  "MATLAB demos."
+  (interactive)
+  (comint-send-string (get-buffer-process (current-buffer)) "demo\n"))
+
+(defun matlab-shell-close-figures ()
+  "Close any open figures."
+  (interactive)
+  (comint-send-string (get-buffer-process (current-buffer)) "close all\n"))
+
+(defun matlab-shell-close-current-figure ()
+  "Close current figure."
+  (interactive)
+  (comint-send-string (get-buffer-process (current-buffer)) "delete(gcf)\n"))
+
+(defun matlab-shell-exit ()
+  "Exit MATLAB shell."
+  (interactive)
+  (comint-send-string (get-buffer-process (current-buffer)) "exit\n")
+  (kill-buffer nil))
+
+
+;;; matlab-shell based Topic Browser and Help =================================
+
+(defcustom matlab-shell-topic-mode-hook nil
+  "*MATLAB shell topic hook."
+  :group 'matlab-shell
+  :type 'hook)
+
+(defvar matlab-shell-topic-current-topic nil
+  "The currently viewed topic in a MATLAB shell topic buffer.")
+
+(defun matlab-shell-topic-browser ()
+  "Create a topic browser by querying an active MATLAB shell using HELP.
+Maintain state in our topic browser buffer."
+  (interactive)
+  ;; Reset topic browser if it doesn't exist.
+  (if (not (get-buffer "*MATLAB Topic*"))
+      (setq matlab-shell-topic-current-topic nil))
+  (let ((b (get-buffer-create "*MATLAB Topic*")))
+    (switch-to-buffer b)
+    (if (string= matlab-shell-topic-current-topic "")
+	nil
+      (matlab-shell-topic-mode)
+      (matlab-shell-topic-browser-create-contents ""))))
+
+(defvar matlab-shell-topic-mouse-face-keywords
+  '(;; These are subtopic fields...
+    ("^\\(\\w+/\\w+\\)[ \t]+-" 1 font-lock-reference-face)
+    ;; These are functions...
+    ("^[ \t]+\\(\\w+\\)[ \t]+-" 1 font-lock-function-name-face)
+    ;; Here is a See Also line...
+    ("[ \t]+See also "
+     ("\\(\\w+\\)\\([,.]\\| and\\|$\\) *" nil nil (1 font-lock-reference-face))))
+  "These are keywords we also want to put mouse-faces on.")
+
+(defvar matlab-shell-topic-font-lock-keywords
+  (append matlab-shell-topic-mouse-face-keywords
+	  '(("^[^:\n]+:$" 0 font-lock-keyword-face)
+	    ;; These are subheadings...
+	    ("^[ \t]+\\([^.\n]+[a-zA-Z.]\\)$" 1 'underline)
+	    ))
+  "Keywords useful for highlighting a MATLAB TOPIC buffer.")
+
+(defvar matlab-shell-help-font-lock-keywords
+  (append matlab-shell-topic-mouse-face-keywords
+	  '(;; Function call examples
+	    ("[ \t]\\([A-Z]+\\)\\s-*=\\s-*\\([A-Z]+[0-9]*\\)("
+	     (1 font-lock-variable-name-face)
+	     (2 font-lock-function-name-face))
+	    ("[ \t]\\([A-Z]+[0-9]*\\)("
+	     (1 font-lock-function-name-face))
+	    ;; Parameters: Not very accurate, unfortunately.
+	    ("[ \t]\\([A-Z]+[0-9]*\\)("
+	     ("'?\\(\\w+\\)'?\\([,)]\\) *" nil nil
+	      (1 font-lock-variable-name-face))
+	     )
+	    ;; Reference uppercase words
+	    ("\\<\\([A-Z]+[0-9]*\\)\\>" 1 font-lock-reference-face)))
+  "Keywords for regular help buffers.")
+
+;; View-major-mode is an emacs20 thing.  This gives us a small compatibility
+;; layer.
+(if (not (fboundp 'view-major-mode)) (defalias 'view-major-mode 'view-mode))
+
+(define-derived-mode matlab-shell-help-mode
+  view-major-mode "M-Help"
+  "Major mode for viewing MATLAB help text.
+Entry to this mode runs the normal hook `matlab-shell-help-mode-hook'.
+
+Commands:
+\\{matlab-shell-help-mode-map}"
+  (make-local-variable 'font-lock-defaults)
+  (setq font-lock-defaults '((matlab-shell-help-font-lock-keywords)
+			     t nil ((?_ . "w"))))
+  ;; This makes sure that we really enter font lock since
+  ;; kill-all-local-variables is not used by old view-mode.
+  (and (boundp 'global-font-lock-mode) global-font-lock-mode
+       (not font-lock-mode) (font-lock-mode 1))
+  (easy-menu-add matlab-shell-help-mode-menu matlab-shell-help-mode-map)
+  (matlab-shell-topic-mouse-highlight-subtopics)
+  )
+
+(define-key matlab-shell-help-mode-map [return] 'matlab-shell-topic-choose)
+(define-key matlab-shell-help-mode-map "t" 'matlab-shell-topic-browser)
+(define-key matlab-shell-help-mode-map "q" 'bury-buffer)
+(define-key matlab-shell-help-mode-map
+  [(control h) (control m)] matlab-help-map)
+(if (string-match "XEmacs" emacs-version)
+    (define-key matlab-shell-help-mode-map [button2] 'matlab-shell-topic-click)
+  (define-key matlab-shell-help-mode-map [mouse-2] 'matlab-shell-topic-click))
+
+(easy-menu-define
+ matlab-shell-help-mode-menu matlab-shell-help-mode-map
+ "MATLAB shell topic menu"
+ '("MATLAB Help"
+   ["Describe This Command" matlab-shell-topic-choose t]
+   "----"
+   ["Describe Command" matlab-shell-describe-command t]
+   ["Describe Variable" matlab-shell-describe-variable t]
+   ["Command Apropos" matlab-shell-apropos t]
+   ["Topic Browser" matlab-shell-topic-browser t]
+   "----"
+   ["Exit" bury-buffer t]))
+
+(define-derived-mode matlab-shell-topic-mode
+  matlab-shell-help-mode "M-Topic"
+  "Major mode for browsing MATLAB HELP topics.
+The output of the MATLAB command HELP with no parameters creates a listing
+of known help topics at a given installation.  This mode parses that listing
+and allows selecting a topic and getting more help for it.
+Entry to this mode runs the normal hook `matlab-shell-topic-mode-hook'.
+
+Commands:
+\\{matlab-shell-topic-mode-map}"
+  (setq font-lock-defaults '((matlab-shell-topic-font-lock-keywords)
+			     t t ((?_ . "w"))))
+  (if (string-match "XEmacs" emacs-version)
+      (setq mode-motion-hook 'matlab-shell-topic-highlight-line))
+  (easy-menu-add matlab-shell-topic-mode-menu matlab-shell-topic-mode-map)
+  )
+
+(easy-menu-define
+ matlab-shell-topic-mode-menu matlab-shell-topic-mode-map
+ "MATLAB shell topic menu"
+ '("MATLAB Topic"
+   ["Select This Topic" matlab-shell-topic-choose t]
+   ["Top Level Topics" matlab-shell-topic-browser t]
+   "----"
+   ["Exit" bury-buffer t]))
+
+(defun matlab-shell-topic-browser-create-contents (subtopic)
+  "Fill in a topic browser with the output from SUBTOPIC."
+  (toggle-read-only -1)
+  (erase-buffer)
+  (insert (matlab-shell-collect-command-output (concat "help " subtopic)))
+  (goto-char (point-min))
+  (forward-line 1)
+  (delete-region (point-min) (point))
+  (setq matlab-shell-topic-current-topic subtopic)
+  (if (not (string-match "XEmacs" emacs-version))
+      (matlab-shell-topic-mouse-highlight-subtopics))
+  (toggle-read-only 1)
+  )
+
+(defun matlab-shell-topic-click (e)
+  "Click on an item in a MATLAB topic buffer we want more information on.
+Must be bound to event E."
+  (interactive "e")
+  (mouse-set-point e)
+  (matlab-shell-topic-choose))
+
+(defun matlab-shell-topic-choose ()
+  "Choose the topic to expand on that is under the cursor.
+This can fill the topic buffer with new information.  If the topic is a
+command, use `matlab-shell-describe-command' instead of changing the topic
+buffer."
+  (interactive)
+  (let ((topic nil) (fun nil) (p (point)))
+    (save-excursion
+      (beginning-of-line)
+      (if (looking-at "^\\w+/\\(\\w+\\)[ \t]+-")
+	  (setq topic (match-string 1))
+	(if (looking-at "^[ \t]+\\(\\(\\w\\|_\\)+\\)[ \t]+-")
+	    (setq fun (match-string 1))
+	  (if (and (not (looking-at "^[ \t]+See also"))
+		   (not (save-excursion (forward-char -2)
+					(looking-at ",$"))))
+	      (error "You did not click on a subtopic, function or reference")
+	    (goto-char p)
+	    (forward-word -1)
+	    (if (not (looking-at "\\(\\(\\w\\|_\\)+\\)\\([.,]\\| and\\|\n\\)"))
+		(error "You must click on a reference")
+	      (setq topic (match-string 1)))))))
+    (message "Opening item %s..." (or topic fun))
+    (if topic
+	(matlab-shell-topic-browser-create-contents (downcase topic))
+      (matlab-shell-describe-command fun))
+    ))
+
+(defun matlab-shell-topic-mouse-highlight-subtopics ()
+  "Put a `mouse-face' on all clickable targets in this buffer."
+  (save-excursion
+    (let ((el matlab-shell-topic-mouse-face-keywords))
+      (while el
+	(goto-char (point-min))
+	(while (re-search-forward (car (car el)) nil t)
+	  (let ((cd (car (cdr (car el)))))
+	    (if (numberp cd)
+		(put-text-property (match-beginning cd) (match-end cd)
+				   'mouse-face 'highlight)
+	      (while (re-search-forward (car cd) nil t)
+		(put-text-property (match-beginning (car (nth 3 cd)))
+				   (match-end (car (nth 3 cd)))
+				   'mouse-face 'highlight)))))
+	(setq el (cdr el))))))
+
+(defun matlab-shell-topic-highlight-line (event)
+  "A value of `mode-motion-hook' which will highlight topics under the mouse.
+EVENT is the user mouse event."
+  ;; XEMACS only function
+  (let* ((buffer (event-buffer event))
+	 (point (and buffer (event-point event))))
+    (if (and buffer (not (eq buffer mouse-grabbed-buffer)))
+	(save-excursion
+	  (save-window-excursion
+	    (set-buffer buffer)
+	    (mode-motion-ensure-extent-ok event)
+	    (if (not point)
+		(detach-extent mode-motion-extent)
+	      (goto-char point)
+	      (end-of-line)
+	      (setq point (point))
+	      (beginning-of-line)
+	      (if (or (looking-at "^\\w+/\\(\\w+\\)[ \t]+-")
+		      (looking-at "^[ \t]+\\(\\(\\w\\|_\\)+\\)[ \t]+-"))
+		  (set-extent-endpoints mode-motion-extent (point) point)
+		(detach-extent mode-motion-extent))))))))
+
+
+;;; M File path stuff =========================================================
+
+(defun matlab-mode-determine-mfile-path ()
+  "Create the path in `matlab-mode-install-path'."
+  (let ((path (file-name-directory matlab-shell-command)))
+    ;; if we don't have a path, find the MATLAB executable on our path.
+    (if (not path)
+	(let ((pl exec-path))
+	  (while (and pl (not path))
+	    (if (and (file-exists-p (concat (car pl) "/" matlab-shell-command))
+		     (not (car (file-attributes (concat (car pl) "/"
+							matlab-shell-command)))))
+		(setq path (car pl)))
+	    (setq pl (cdr pl)))))
+    (if (not path)
+	nil
+      ;; When we find the path, we need to massage it to identify where
+      ;; the M files are that we need for our completion lists.
+      (if (string-match "/bin$" path)
+	  (setq path (substring path 0 (match-beginning 0))))
+      ;; Everything stems from toolbox (I think)
+      (setq path (concat path "/toolbox/")))
+    path))
+
+(defcustom matlab-mode-install-path (list (matlab-mode-determine-mfile-path))
+  "Base path pointing to the locations of all the m files used by matlab.
+All directories under each element of `matlab-mode-install-path' are
+checked, so only top level toolbox directories need be added.
+Paths should be added in the order in which they should be searched."
+  :group 'matlab-shell
+  :type '(repeat (string :tag "Path: ")))
+
+(defun matlab-find-file-under-path (path filename)
+  "Return the pathname or nil of PATH under FILENAME."
+  (if (file-exists-p (concat path filename))
+      (concat path filename)
+    (let ((dirs (if (file-directory-p path)
+		    ;; Not checking as a directory first fails on XEmacs
+		    ;; Stelios Kyriacou 
+		    (directory-files path t nil t)))
+	  (found nil))
+      (while (and dirs (not found))
+	(if (and (car (file-attributes (car dirs)))
+ 		 ;; require directory readable
+ 		 (file-readable-p (car dirs))
+		 ;; don't redo our path names
+		 (not (string-match "/\\.\\.?$" (car dirs)))
+		 ;; don't find files in object directories.
+		 (not (string-match "@" (car dirs))))
+	    (setq found
+		  (matlab-find-file-under-path (concat (car dirs) "/")
+					       filename)))
+	(setq dirs (cdr dirs)))
+      found)))
+
+(defun matlab-find-file-on-path (filename)
+  "Find FILENAME on the current MATLAB path.
+The MATLAB path is determined by `matlab-mode-install-path' and the
+current directory.  You must add user-installed paths into
+`matlab-mode-install-path' if you would like to have them included."
+  (interactive
+   (list
+    (let ((default (matlab-read-word-at-point)))
+      (if default
+	  (let ((s (read-string (concat "File (default " default "): "))))
+	    (if (string= s "") default s))
+	(read-string "File: ")))))
+  (if (string= filename "")
+      (error "You must specify an M file"))
+  (if (not (string-match "\\.m$" filename))
+      (setq filename (concat filename ".m")))
+  (let ((fname nil)
+	(dirs matlab-mode-install-path))
+    (if (file-exists-p (concat default-directory filename))
+	(setq fname (concat default-directory filename)))
+    (while (and (not fname) dirs)
+      (if (stringp (car dirs))
+	  (progn
+	    (message "Searching for %s in %s" filename (car dirs))
+	    (setq fname (matlab-find-file-under-path (car dirs) filename))))
+      (setq dirs (cdr dirs)))
+    (if fname (find-file fname)
+      (error "File %s not found on any known paths.  \
+Check `matlab-mode-install-path'" filename))))
+
+(defun matlab-find-file-click (e)
+  "Find the file clicked on with event E on the current path."
+  (interactive "e")
+  (mouse-set-point e)
+  (let ((f (matlab-read-word-at-point)))
+    (if (not f) (error "To find an M file, click on a word"))
+    (matlab-find-file-on-path f)))
+
+
+;;; matlab-mode debugging =====================================================
+
+(defun matlab-show-line-info ()
+  "Display type and attributes of current line.  Used in debugging."
+  (interactive)
+  (let ((msg "line-info:")
+	(indent (matlab-calculate-indentation (current-indentation)))
+	(nexti (matlab-next-line-indentation)))
+    (setq msg (concat msg
+		      " Line type: " (symbol-name (car indent))
+		      " This Line: " (int-to-string (nth 1 indent))
+		      " Next Line: " (int-to-string nexti)))
+    (if (matlab-lattr-cont)
+	(setq msg (concat msg " w/cont")))
+    (if (matlab-lattr-comm)
+	(setq msg (concat msg " w/comm")))
+    (message msg)))
+
+(provide 'matlab)
+
+;;; matlab.el ends here
diff --git a/elisp/emacs-goodies-el/minibuf-electric.el b/elisp/emacs-goodies-el/minibuf-electric.el
new file mode 100755
index 0000000..f5c5b6e
--- /dev/null
+++ b/elisp/emacs-goodies-el/minibuf-electric.el
@@ -0,0 +1,121 @@
+;;; minibuf-electric.el -- Electric minibuffer behavior from XEmacs.
+;;;
+
+;; Extracted from minibuf.el --- Minibuffer functions for XEmacs
+;; Copyright (C) 1992, 1993, 1994, 1997 Free Software Foundation, Inc.
+;; Copyright (C) 1995 Tinker Systems.
+;; Copyright (C) 1995, 1996, 2000 Ben Wing.
+
+;; Modified by Karl Hegbloom for GNU Emacs.  Taken from XEmacs 21.4
+;; "lisp/minibuf.el".  It needs fine tuning and placement in a
+;; suitable location within the GNU Emacs Lisp tree.  See below for
+;; notes concerning key-maps.
+;;
+;; Submitted for inclusion in the Debian `emacs-goodies-el' package.
+;;
+;; GPL.
+
+;;; Commentary:
+;; 
+;; 
+;; This works with GNU Emacs.  It implements the XEmacs minibuffer
+;; behavior for C-x C-f and other file name reading actions.  When you
+;; type "//", it clears the minibuffer back to the start, leaving only a
+;; single "/".  When you type a "~", it does the similar, leaving only
+;; "~/".  This is nicer than having to explicitly erase the contents of
+;; the minibuffer.
+;; 
+;; In the next GNU Emacs release (V22), the following will achieve this:
+;; 
+;;     (setq file-name-shadow-tty-properties '(invisible t))
+;;     (file-name-shadow-mode 1)
+
+;;; History:
+;; 
+;; 2005-09-26 Peter Galbraith 
+;;  - checkdoc clean.  Added command doc strings.
+;;  - added commentary from Karl's email about the file.
+
+
+;;; Code:
+(defcustom minibuffer-electric-file-name-behavior nil
+  "*If non-nil, slash and tilde in certain places cause immediate deletion.
+These are the same places where this behavior would occur later on anyway,
+in `substitute-in-file-name'."
+  :type 'boolean
+  :require 'minibuf-electric
+  :group 'minibuffer)
+
+;;; originally by Stig@hackvan.com, taken from XEmacs 21.4
+;;;
+(defun minibuffer-electric-separator ()
+  "Insert / separator, but clear line first if typed twice in a row."
+  (interactive)
+  (let ((c last-command-char))
+    (and minibuffer-completing-file-name ; added for GNU Emacs
+	 minibuffer-electric-file-name-behavior
+	 (eq c directory-sep-char)
+	 (eq c (char-before (point)))
+	 (not (save-excursion		;; ange-ftp, tramp
+		(goto-char (minibuffer-prompt-end))
+		(and (looking-at "/.+:~?[^/]*/.+")
+		     (re-search-forward "/.+:~?[^/]*" nil t)
+		     (progn
+		       (delete-region (point) (point-max))
+		       t))))
+	 (not (save-excursion
+		(goto-char (minibuffer-prompt-end))
+		(and (looking-at ".+://[^/]*/.+")
+		     (re-search-forward ".+:/" nil t)
+		     (progn
+		       (delete-region (point) (point-max))
+		       t))))
+	 ;; permit `//hostname/path/to/file'
+	 (not (eq (point) (1+ (minibuffer-prompt-end))))
+	 ;; permit `http://url/goes/here'
+	 (or (not (eq ?: (char-after (- (point) 2))))
+	     (eq ?/ (char-after (minibuffer-prompt-end))))
+       (delete-region (minibuffer-prompt-end) (point)))
+    (insert c)))
+
+(defun minibuffer-electric-tilde ()
+  "Insert ~ but clear line first if twice not in logical place."
+  (interactive)
+  (and minibuffer-completing-file-name	; Added for GNU Emacs
+       minibuffer-electric-file-name-behavior
+       (eq directory-sep-char (char-before (point)))
+       ;; permit URL's with //, for e.g. http://hostname/~user
+       (not (save-excursion (search-backward "//" (minibuffer-prompt-end) t)))
+       (delete-region (minibuffer-prompt-end) (point)))
+  (insert ?~))
+
+
+;;; This is really not quite right, but I don't know how to do the
+;;; right thing yet.  What's the matter is that these keys should
+;;; really only be bound when the minibuffer is reading a file name.
+;;; I'm afraid that these key maps may be too general and might be the
+;;; ones used when reading other things.  If they really are used only
+;;; for reading file names, then I think they are mis-named, and
+;;; should be named more specifically.
+;;;
+;;; For now, it works for me with `find-file', `find-alternate-file',
+;;; and `write-file', which all seem to use
+;;; `minibuffer-local-completion-map'.  The `insert-file' defun uses
+;;; the `minibuffer-local-must-match-map'.
+
+(define-key minibuffer-local-completion-map
+  (char-to-string directory-sep-char)
+  #'minibuffer-electric-separator)
+
+(define-key minibuffer-local-must-match-map
+  (char-to-string directory-sep-char)
+  #'minibuffer-electric-separator)
+
+(define-key minibuffer-local-completion-map "~" #'minibuffer-electric-tilde)
+(define-key minibuffer-local-must-match-map "~" #'minibuffer-electric-tilde)
+
+(provide 'minibuf-electric)
+
+(provide 'minibuf-electric)
+
+;;; minibuf-electric.el ends here
diff --git a/elisp/emacs-goodies-el/minibuffer-complete-cycle.el b/elisp/emacs-goodies-el/minibuffer-complete-cycle.el
new file mode 100644
index 0000000..1626d19
--- /dev/null
+++ b/elisp/emacs-goodies-el/minibuffer-complete-cycle.el
@@ -0,0 +1,266 @@
+;;; minibuffer-complete-cycle.el --- Cycle through the *Completions* buffer
+
+;; Copyright © 1997,1998,2000,2003,2006 Kevin Rodgers
+;; Copyright © 2013 Akinori MUSHA
+
+;; Author: Akinori MUSHA 
+;;         Kevin Rodgers 
+;; Maintainer: Akinori MUSHA 
+;; URL: https://github.com/knu/minibuffer-complete-cycle
+;; Created: 15 Oct 1997
+;; Version: 1.25.20130814
+;; Keywords: completion
+;; X-Original-Version: $Revision: 1.5 $
+;; X-Original-RCS: $Id: minibuffer-complete-cycle.el,v 1.5 2016/11/06 19:31:23 psg Exp $
+
+;; 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:
+
+;; The `minibuffer-complete' command, bound by default to TAB in the
+;; minibuffer completion keymaps, displays the list of possible
+;; completions when no additional characters can be completed.
+;; Subsequent invocations of this command cause the window displaying
+;; the *Completions* buffer to scroll, if necessary.
+;; 
+;; This library advises the `minibuffer-complete' command so that
+;; subsequent invocations instead select each of the possible
+;; completions in turn, inserting it into the minibuffer and
+;; highlighting it in the *Completions* buffer.  As before, the window
+;; displaying the possible completions is scrolled if necessary.  This
+;; feature is enabled by loading this file and setting the
+;; `minibuffer-complete-cycle' option to t with `M-x customize-variable'
+;; or `M-x set-variable'; it is disabled by unsetting the option (to
+;; nil).  Besides t, the special value `auto' enables the feature and
+;; also causes the first completion to be selected immediately.
+;; 
+;; You can also customize the `minibuffer-complete-cycle' face, which is
+;; used to highlight the selected completion, with `M-x customize-face'
+;; or any of the `M-x set-face-' commands.
+
+;; The technique of deleting the minibuffer contents, then (for file
+;; name completion) inserting the directory component of the initial
+;; input, and then inserting the completion string itself is based on
+;; cycle-mini.el (1.03) by Joe Reiss .
+;;
+;; Emacs 24 introduced `completion-cycle-threshold' which achieves a
+;; similar goal.  This extension allows you to see the completion
+;; window while cycling, and to cycle backward with .
+
+;;; Change log:
+;;
+;; Version 1.25.20130814  2013-08-14  Akinori MUSHA
+;;   Support for Emacs 24.
+;;   Fix a bug with partial completion.
+;;   Fix a bug when the minibuffer is like "~/dir1/~/".
+;;   Bind  to minibuffer-complete-backward rather than M-TAB.
+;;   Make the slash key settle the curent path component if appropriate.
+
+;;; Code:
+
+;; Package interface:
+(provide 'minibuffer-complete-cycle)
+
+(require 'custom)			; defgroup, defcustom, defface
+
+(eval-when-compile (require 'cl))
+
+;; User options:
+
+(defgroup minibuffer-complete-cycle nil
+  "Cycle through the *Completions* buffer."
+  :group 'completion)
+
+(defcustom minibuffer-complete-cycle nil
+  "*If non-nil, `minibuffer-complete' cycles through the possible completions.
+If `auto', `minibuffer-complete' selects the first completion immediately."
+  :type '(choice (const t) (const auto) (const nil))
+  :group 'minibuffer-complete-cycle
+  :require 'minibuffer-complete-cycle)
+
+(defface minibuffer-complete-cycle
+  '((t (:inherit secondary-selection)))
+  "Face for highlighting the selected completion in the *Completions* buffer."
+  :group 'minibuffer-complete-cycle)
+
+;; Internal variables:
+(defvar mcc-completion-begin nil	; point in the *Completions* buffer
+  "If non-nil, the beginning of the selected completion.")
+(defvar mcc-completion-end nil		; point in the *Completions* buffer
+  "If non-nil, the end of the selected completion.")
+
+(defvar mcc-completion-property
+  'mouse-face
+  "The text property used to identify completions.")
+
+(defvar mcc-overlay
+  (let ((overlay (make-overlay 1 1)))
+    (overlay-put overlay 'face 'minibuffer-complete-cycle)
+    overlay)
+  "If non-nil, the overlay used to highlight the *Completions* buffer.")
+
+
+;; Commands:
+
+(defadvice minibuffer-complete (around cycle (&optional count) activate compile)
+  "If the `minibuffer-complete-cycle' option is set, then instead of
+just scrolling the window of possible completions, insert each one in
+turn in the minibuffer and highlight it in the *Completions* buffer with
+the `minibuffer-complete-cycle' face.
+
+Prefix arg means select the COUNT'th next completion.
+To cycle to previous completions, type ."
+;; `\\\\[minibuffer-complete-backward]'
+  (interactive "p")
+  (if (and minibuffer-complete-cycle
+           (not (eq this-command 'completion-at-point)) ; Emacs 24
+           ;; See Fminibuffer_complete:
+           (or (eq last-command this-command)
+               (eq last-command 'completion-at-point)   ; Emacs 24
+               (and (eq minibuffer-complete-cycle 'auto)
+                    (progn
+                      (setq mcc-completion-begin nil
+                            mcc-completion-end nil)
+                      ad-do-it)))
+           minibuffer-scroll-window
+           (window-live-p minibuffer-scroll-window))
+      (let ((lastlen (and mcc-completion-begin mcc-completion-end
+                      (- mcc-completion-end mcc-completion-begin)))
+            (completion (mcc-completion-string count)))
+        (cond (lastlen
+               ;; Delete the part last completed
+               (delete-region (- (point-max) lastlen)
+                              (point-max)))
+              (minibuffer-completing-file-name
+               ;; Skip the last component
+               (or (re-search-backward "/" (minibuffer-prompt-end) t)
+                   (goto-char (minibuffer-prompt-end)))
+               ;; Skip components to be completed
+               (let ((str (directory-file-name completion))
+                     (start 0))
+                 (while (string-match "/" str start)
+                   (setq start (match-end 0))
+                   (or (re-search-backward "/" (minibuffer-prompt-end) t)
+                       (goto-char (minibuffer-prompt-end))))
+                 (if (looking-at "/") (forward-char 1))
+                 (delete-region (point) (point-max))))
+              (t (delete-region (minibuffer-prompt-end)
+                                (point-max))))
+        (insert completion)
+        (mcc-display-completion (< count 0)))
+    ;; Reset the mcc variables and proceed normally:
+    (setq mcc-completion-begin nil
+          mcc-completion-end nil)
+    ad-do-it))
+
+(defun minibuffer-complete-backward (&optional count)
+  "Just like `minibuffer-complete', but cycle to the previous completion.
+Prefix arg means select the COUNT'th previous completion."
+  (interactive "p")
+  (setq this-command 'minibuffer-complete)
+  (minibuffer-complete (- count)))
+
+(defun minibuffer-complete-slash (&optional arg)
+  "Insert a slash ARG times, or settle the current path component if complete-cycling is at a directory name."
+  (interactive "p")
+  (or
+   (and (= arg 1)
+        (eq last-command 'minibuffer-complete)
+        minibuffer-completing-file-name
+        (eolp)
+        (char-equal (preceding-char) ?/))
+   (self-insert-command arg)))
+
+;; Functions:
+
+;;;###autoload
+(defun mcc-define-keys ()	; mcc-minor-mode & -keymap
+  "Define extra key bindings in the local keymap.
+This has no effect unless the `minibuffer-complete-cycle' option is set."
+  (when minibuffer-complete-cycle
+    (dolist (binding
+             '(("" . minibuffer-complete-backward)
+               ("/"         . minibuffer-complete-slash)
+               ))
+      (let ((key (kbd (car binding)))
+            (func (cdr binding)))
+        (and (null (local-key-binding key))
+             (local-set-key key func))))))
+
+;;;###autoload
+(add-hook 'minibuffer-setup-hook 'mcc-define-keys)
+
+(defun mcc-completion-string (n)
+  "Return the Nth next completion.
+If N is negative, return the Nth previous completion."
+  (let ((completion-buffer (window-buffer minibuffer-scroll-window)))
+    ;; Verify the buffer and window configuration:
+    (or (eq completion-buffer (get-buffer "*Completions*"))
+	(error "minibuffer-scroll-window isn't displaying \
+the *Completions* buffer"))
+    (save-excursion
+      (set-buffer completion-buffer)
+      ;; Find the beginning and end of the completion:
+      (if (< n 0)
+	  (while (< n 0)
+	    (setq mcc-completion-end
+		  (or (and mcc-completion-begin
+			   (previous-single-property-change mcc-completion-begin
+							    mcc-completion-property))
+		      (point-max)))
+	    (setq mcc-completion-begin
+		  (previous-single-property-change mcc-completion-end
+						   mcc-completion-property
+						   nil (point-min)))
+	    (setq n (1+ n)))
+	(while (> n 0)
+	  (setq mcc-completion-begin
+		(next-single-property-change (if (and mcc-completion-end
+						      (< mcc-completion-end
+							 (point-max)))
+						 mcc-completion-end
+					       (point-min))
+					     mcc-completion-property))
+	  (setq mcc-completion-end
+		(next-single-property-change mcc-completion-begin
+					     mcc-completion-property
+					     nil (point-max)))
+	  (setq n (1- n))))
+      (buffer-substring-no-properties mcc-completion-begin mcc-completion-end))))
+
+(defun mcc-display-completion (&optional backward)
+  "Highlight the current completion and scroll the *Completions* buffer \
+if necessary.
+Scroll up by default, but scroll down if BACKWARD is non-nil."
+  (let ((completion-buffer (window-buffer minibuffer-scroll-window))
+	(minibuffer-window (selected-window)))
+    (if mcc-overlay
+        (move-overlay mcc-overlay mcc-completion-begin mcc-completion-end
+                      completion-buffer))
+    (unwind-protect
+	(progn
+	  (select-window minibuffer-scroll-window) ; completion-buffer
+	  (or (pos-visible-in-window-p mcc-completion-begin)
+	      (if backward
+		  (if (= (window-start) (point-min))
+		      (set-window-point (selected-window) (point-max))
+		    (scroll-down))
+		(if (= (window-end) (point-max))
+		    (set-window-point (selected-window) (point-min))
+		  (scroll-up)))))
+      (select-window minibuffer-window))))
+
+;;; minibuffer-complete-cycle.el ends here
diff --git a/elisp/emacs-goodies-el/miniedit.el b/elisp/emacs-goodies-el/miniedit.el
new file mode 100755
index 0000000..46f4bab
--- /dev/null
+++ b/elisp/emacs-goodies-el/miniedit.el
@@ -0,0 +1,427 @@
+;;; miniedit.el --- Enhanced editing for minibuffer fields.
+;; Time-stamp: <2010-04-06 19:05:08 deego>
+;; Copyright (C) 2001, 2002 Free Software Foundation, Inc.
+;; Emacs Lisp Archive entry
+;; Filename: miniedit.el
+;; Package: miniedit
+;; Author(s): Deepak Goel ,
+;;            Christoph Conrad 
+;; Version: 2.0
+;; Author's homepage: http://www.gnufans.net/~deego/DeegoWiki/DeepakGoel.html
+;; For latest version:
+
+(defconst miniedit-home-page
+  "http://gnufans.net/~deego/emacspub/lisp-mine/miniedit/")
+;; 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.
+ 
+
+;; See also:
+
+
+;; Quick start:
+(defconst miniedit-quick-start
+  "Drop this file somewhere in your load-path, and add somewhere in your  .emacs.
+ \(require 'miniedit\)
+ \(miniedit-install\)
+Xemacsers use \(miniedit-install-for-xemacs\) instead of
+\(miniedit-install\).
+
+Installation can also be done by customizing the variable `miniedit-install'.
+
+Then, type M-C-e in any minibuffer to do nicer edits, and type M-C-c
+or C-c C-c when done.
+
+Please type M-x miniedit-introduction, M-x miniedit-quick-start and
+M-x miniedit-commentary for more details. "
+)
+
+;;;###autoload
+(defun miniedit-quick-start ()
+  "Provides electric help for function `miniedit-quick-start'."
+  (interactive)
+  (with-electric-help
+   '(lambda () (insert miniedit-quick-start) nil) "*doc*"))
+
+;;; Introduction:
+;; Stuff that gets posted to gnu.emacs.sources
+;; as introduction
+(defconst miniedit-introduction
+  "Helps easily edit minibuffers.
+Adds a key \"C-M-e\" \(e for edit\) to the minibuffer-local-map, and
+other similar maps, and bind it to the function `miniedit'. This
+means that when you are in a minibuffer, trying to input text,
+you can type C-M-e to go enter those fields in a nice, full buffer
+\(with text mode\) instead.  In particular, inserting new lines and
+indenting is easy.  Helpful, for instance, when editing bbdb notes
+fields, which tend to be multiline, \(right?\)
+
+P.S.: Lots of code borrowed from checkdoc.
+
+Tested mainly on emacs21.  It may now work even on Xemacs, `
+atleast for some of the minibuffer-maps.
+
+Please type M-x miniedit-introduction, M-x miniedit-quick-start and
+M-x miniedit-commentary for more details. ")
+
+;;;###autoload
+(defun miniedit-introduction ()
+  "Provides electric help for function `miniedit-introduction'."
+  (interactive)
+  (with-electric-help
+   '(lambda () (insert miniedit-introduction) nil) "*doc*"))
+
+(defvar miniedit-version "2.0")
+
+;;; BUGS:
+;;   Commit problem:  Once you are in the miniedit buffer, if you move
+;;   buffers around, switch back and forth etc., the commit *sometimes*
+;;   fails.. the author is working on this.... :)
+;;   that is why we kill-new and have variables like
+;;   miniedit-before-edit-kill-p and miniedit-after-edit-kill-p. -- to
+;;   save any lost data.
+;;==========================================
+;;; code:
+(eval-when-compile (require 'custom))
+(eval-when-compile
+  (require 'cl))
+
+(defgroup miniedit nil
+  "Miniedit"
+  :group 'applications)
+
+(defcustom miniedit-install-p nil
+  "Whether to setup miniedit for use."
+  :type 'boolean
+  :set (lambda (symbol value)
+         (set-default symbol value)
+         (when value
+           (if (string-match "XEmacs" emacs-version)
+               (miniedit-install-for-xemacs)
+             (miniedit-install))))
+  :require 'miniedit
+  :group 'miniedit)
+
+(defcustom miniedit-before-edit-kill-p nil
+  "Add to kill ring before starting edit?"
+  :group 'miniedit)
+
+(defcustom miniedit-before-commit-kill-p nil
+  "Add the string to `kill-ring' before committing?"
+  :group 'miniedit
+)
+
+(defcustom miniedit-before-edit-function nil
+ "Function to run on minibuffer-string before editing.
+
+If this variable points to a function-name, that function is run on
+the string that is gotten from the minibuffer..  The function should
+do whatever it wants, and then it should return a (possibly) modified
+string.  That modified string is what becomes the string to be
+edited."
+
+ :group 'miniedit
+)
+
+(defcustom miniedit-before-commit-function nil
+ "If non-nil, function to run on minibuffer-string after editing.
+
+If this variable points to a function-name, that function is run on
+the string that is read from the miniedit-buffer..  The function should
+do whatever it wants, and then it should return a (possibly) modified
+string.  That modified string is what gets committed to the
+minibuffer."
+ :group 'miniedit
+
+)
+
+
+(defcustom miniedit-before-edit-hook nil
+  "A hook thatis run before editing begins.."
+  :group 'miniedit
+)
+
+(defcustom miniedit-before-commit-hook nil
+  "A hook that is run before commitment to the minibuffer."
+  :group 'miniedit
+)
+
+(defvar miniedit-string "miniedit-default-string"
+  "This varible is what shall store the miniedit string temporarily...
+This variable is introduced so that various miniedit-hooks can be used to
+modify this string..")
+
+
+
+(defmacro miniedit-withit (expr &rest rest)
+  "Bind it to EXPR and do `REST'.
+
+Caution: var-capture by its very nature.."
+  `(let ((it ,expr))
+     ,@rest))
+
+;;;  Tom Fawcett 
+;; For us xemacs users who don't have princ-list
+;(eval-when-compile
+;  (unless (fboundp 'princ-list)
+;    (defmacro princ-list (&rest things)
+;      (cons 'progn (mapcar #'(lambda (x) `(princ ,x)) things)))))
+
+;; special handling because princ-list is not defined for xemacs..
+
+;;copied from mule-cmds.. and renamed...
+(defun miniedit-princ-list (&rest args)
+  "Same as `princ-list', but provided for Xemacs.  Print ARGS."
+  (while args (princ (car args)) (setq args (cdr args)))
+  (princ "\n"))
+
+(defcustom miniedit-show-help-p t
+  "Whether to pop up the help-buffer.."
+  :type 'boolean
+  :group 'miniedit)
+
+(defcustom miniedit-fill-column-deduction 14
+  "The `fill-column' will be reduced from its default by this amount.
+
+One would like this because part of the minibuffer is occupied by the
+prompt string.  And, for instance, because in bbdb's notes, a large
+left margin is taken up by the entry \"notes:\".
+
+This variable can be assigned *anything* which results in an integer
+when eval'ed."
+  :group 'miniedit :type 'integer
+
+)
+
+ 
+;;;###autoload
+(defun miniedit ()
+  "The main miniedit function."
+  (interactive)
+  (let ((miniedit-string miniedit-string)
+	(minibufname (buffer-name))
+	)
+    (save-excursion
+      ;; so that it can be redefined below..
+      (makunbound 'miniedit-mode-map)
+      (easy-mmode-define-minor-mode
+       miniedit-mode
+       "The mode to inherit minibuffer keybindings"
+       nil
+       " MINI"
+       ;; 3 means C-c
+       ;; 16 means C-p
+       (list 'keymap (cons 16 (current-local-map))))
+      (define-key miniedit-mode-map (kbd "C-c C-c") 'exit-recursive-edit)
+      (let ((contents
+	     (miniedit-recursive-edit
+	      ""
+	      (progn
+		(setq miniedit-string
+		      (minibuffer-contents-no-properties))
+		 (when (and
+			(stringp miniedit-string)
+			miniedit-before-edit-kill-p)
+		   (kill-new miniedit-string))
+		 (when
+		     miniedit-before-edit-function
+		   (miniedit-withit
+		    (funcall miniedit-before-edit-function
+			     miniedit-string)
+		    (when it (setq miniedit-string it))))
+		 (run-hooks 'miniedit-before-editing-hook)
+		 miniedit-string)
+	      
+	      )))
+	(delete-other-windows)
+	(other-window 1)
+	(miniedit-set-minibuffer-contents contents minibufname)
+	))))
+ 
+(defun miniedit-set-minibuffer-contents (contents minibuffer-name)
+  "Set `minibuffer-contents' to CONTENTS.
+The name of the minibuffer is MINIBUFFER-NAME.
+
+version 21 or higher only.."
+  (set-buffer minibuffer-name)
+  (delete-minibuffer-contents)
+  (insert contents))
+ 
+
+;;;###autoload
+(defun miniedit-install ()
+  "Install miniedit by frobbing your miniedit-local maps."
+  (interactive)
+  (define-key minibuffer-local-map "\M-\C-e" 'miniedit)
+  (define-key minibuffer-local-ns-map "\M-\C-e" 'miniedit)
+  (define-key minibuffer-local-completion-map "\M-\C-e" 'miniedit)
+  (define-key minibuffer-local-must-match-map "\M-\C-e" 'miniedit)
+  (when (interactive-p)
+    (message "Miniedit installed.."))
+  )
+
+;;; 2002-05-03 T20:51:31-0400 (Friday)    D. Goel
+;;;###autoload
+(defun miniedit-install-for-xemacs ()
+  "Try to Install miniedit for Xemacs."
+  (interactive)
+  (ignore-errors (define-key minibuffer-local-map "\M-\C-e" 'miniedit))
+  ;;(define-key minibuffer-local-ns-map "\M-\C-e" 'miniedit)
+  (ignore-errors (define-key minibuffer-local-completion-map "\M-\C-e" 'miniedit))
+  (ignore-errors (define-key minibuffer-local-must-match-map "\M-\C-e" 'miniedit))
+  )
+
+;; silence the compiler:
+(defun miniedit-mode (&rest arg)
+  "Miniedit mode.
+Optional argument ARG is ignored."
+nil)
+
+(defun miniedit-recursive-edit (msg &optional content)
+  "Enter recursive edit to permit a user to edit long contents..
+Useful when the original contents are in a minibuffer.  Transfer those
+contents to a new buffer and edit them there.
+
+MSG is a message, which is displayed in a Edit buffer.
+Mostly copied from `checkdoc-recursive-edit'.
+CONTENT is the content to be edited..
+Then, returns a string...
+
+Optimized for being called when the current buffer is a minibuffer.."
+  (let ((this-buffer (buffer-name))
+	(new-content content)
+	save-content
+	(errorp nil)
+	)
+    (save-excursion
+      (other-window 1)
+      (switch-to-buffer "*Miniedit*")
+      (set-buffer "*Miniedit*")
+      (setq save-content (buffer-substring (point-min) (point-max)))
+      (delete-region (point-min) (point-max))
+      (text-mode)
+      (miniedit-mode t)
+      (let ((fill-column (- fill-column
+			    (eval miniedit-fill-column-deduction))))
+	(if (stringp content) (insert content)
+	  (setq errorp t))
+	(unless errorp
+	  (miniedit-show-help
+	   "Read THIS MESSAGE --->\n  " msg
+	   "\n\nEdit field, and press C-c C-c or C-M-c to continue.")
+
+
+	  (message "When you're done editing press C-M-c to continue.")
+
+	  (unwind-protect
+	      (recursive-edit)
+	    (if (get-buffer-window "*Miniedit*")
+		(progn
+		  (progn
+		    (setq new-content (buffer-substring
+				       (point-min) (point-max)))
+		    ;;(delete-window (get-buffer-window "*Miniedit*"))
+		    (kill-buffer "*Miniedit*")
+		    )))
+	    (when
+		(get-buffer "*Miniedit Help*")
+	      (kill-buffer "*Miniedit Help*")))))
+      (unless (stringp new-content)
+	(setq errorp t))
+
+      
+      ;;user-customization of new content begins..
+      (setq miniedit-string
+	    new-content)
+      (when (and
+	     (stringp miniedit-string)
+	     miniedit-before-commit-kill-p)
+	(kill-new miniedit-string))
+      (when
+	  miniedit-before-commit-function
+	(miniedit-withit
+	 (funcall miniedit-before-commit-function
+		  miniedit-string)
+	 (when it (setq miniedit-string it))))
+      (run-hooks 'miniedit-before-committing-hook)
+	;;user-customization of new content ends..
+	
+
+      (if (not errorp)
+	  new-content
+	save-content))))
+
+
+
+
+(defun miniedit-recursive-edit-no-mini (msg &optional content)
+  "No use of this function is currently known.
+Enter recursive edit to permit a user to edit long bbdb contents..
+MSG is a message, which is displayed in a Edit buffer.
+Mostly copied from `checkdoc-recursive-edit'.
+CONTENT is the content to be edited..
+Then, returns a string...
+
+Optimized for being called when the current buffer is not a minibuffer.."
+  (let ((this-buffer (buffer-name))
+	(new-content content)
+	)
+    (save-excursion
+      ;(other-window 1)
+      (switch-to-buffer "*Miniedit*")
+      (set-buffer "*Miniedit*")
+      (kill-region (point-min) (point-max))
+      (text-mode)
+      (let ((fill-column (- fill-column 16)))
+	(if (stringp content) (insert content))
+	(with-output-to-temp-buffer "*Miniedit Help*"
+	  (miniedit-princ-list
+	   "IMPORTANT: Read THIS MESSAGE --->\n  " msg
+	   "\n\nEdit field, and press C-M-c to continue."))
+	(shrink-window-if-larger-than-buffer
+	 (get-buffer-window "*Miniedit Help*"))
+	(message "When you're done editing press C-M-c to continue.")
+	(unwind-protect
+	    (recursive-edit)
+	  (if (get-buffer-window "*Miniedit*")
+	      (progn
+		(progn
+		  (setq new-content (buffer-substring
+				     (point-min) (point-max)))
+		  (delete-window (get-buffer-window "*Miniedit*"))
+		  (kill-buffer "*Miniedit*")
+		  )))
+	  (kill-buffer "*Miniedit Help*")))
+      (switch-to-buffer this-buffer)
+      new-content)))
+  
+
+(defun miniedit-show-help (&rest args)
+  "Show help.
+Optional argument ARGS will be ignored."
+  (when miniedit-show-help-p
+    (with-output-to-temp-buffer "*Miniedit Help*"
+      (apply 'miniedit-princ-list
+	     args))
+    (shrink-window-if-larger-than-buffer
+     (get-buffer-window "*Miniedit Help*"))))
+
+
+
+(provide 'miniedit)
+
+;;; miniedit.el ends here
diff --git a/elisp/emacs-goodies-el/mutt-alias.el b/elisp/emacs-goodies-el/mutt-alias.el
new file mode 100755
index 0000000..c3803b1
--- /dev/null
+++ b/elisp/emacs-goodies-el/mutt-alias.el
@@ -0,0 +1,126 @@
+;;; mutt-alias.el --- Lookup/insert mutt mail aliases.
+;; Copyright 1999-2008 by Dave Pearson 
+;; $Revision: 1.3 $
+
+;; mutt-alias is free software distributed under the terms of the GNU
+;; General Public Licence, version 2 or (at your option) any later version.
+;; For details see the file COPYING.
+
+;;; Commentary:
+;;
+;; mutt-alias allows you to lookup and insert the expansion of mutt mail
+;; aliases. This is only handy if you use mutt .
+
+;;; TODO:
+;;
+;; o No attempt is made to handle aliases in aliases.
+;; o No attempt is made to handle line continuation.
+
+;;; Code:
+
+;; Things we need:
+
+(require 'cl)
+
+;; Attempt to handle older/other emacs.
+(eval-and-compile
+  ;; If customize isn't available just use defvar instead.
+  (unless (fboundp 'defgroup)
+    (defmacro defgroup  (&rest rest) nil)
+    (defmacro defcustom (symbol init docstring &rest rest)
+      `(defvar ,symbol ,init ,docstring))))
+
+;; Customize options.
+
+(defgroup mutt-alias nil
+  "Lookup mutt mail aliases."
+  :group  'mail
+  :prefix "mutt-alias-")
+
+(defcustom mutt-alias-file-list '("~/.mutt/aliases")
+  "*List of files that contain your mutt aliases."
+  :type  '(repeat (file :must-exist t))
+  :group 'mutt-alias)
+
+(defcustom mutt-alias-cache t
+  "*Should we cache the aliases?"
+  :type  '(choice (const :tag "Always cache the alias list" t)
+                  (const :tag "Always re-load the alias list" nil))
+  :group 'mutt-alias)
+
+;; Non-customize variables.
+
+(defvar mutt-alias-aliases nil
+  "\"Cache\" of aliases.")
+
+;; Main code:
+
+(defun mutt-alias-load-aliases ()
+  "Load aliases from files defined in `mutt-alias-file-list'.
+
+The resulting list is an `assoc' list where the `car' is a string
+representation of the alias and the `cdr' is the expansion of the alias.
+Note that no attempt is made to handle aliases-in-expansions or continued
+lines."
+  (unless (and mutt-alias-aliases mutt-alias-cache)
+    (with-temp-buffer
+      (loop for file in mutt-alias-file-list do (insert-file-contents file))
+      (setf (point) (point-min))
+      (setq mutt-alias-aliases
+            (loop while (search-forward-regexp "^[ \t]*alias +" nil t)
+                  collect (mutt-alias-grab-alias)))))
+  mutt-alias-aliases)
+
+(defun mutt-alias-grab-alias ()
+  "Convert an alias line into a cons.
+
+The resulting `cons' has a `car' that is the alias and the `cdr' is the
+expansion. Note that no attempt is made to handle continued lines."
+  (let ((old-point (point))
+        (end-point)
+        (alias)
+        (expansion))
+    (end-of-line)
+    (setq end-point (point))
+    (setf (point) old-point)
+    (search-forward-regexp "[ \t]" nil t)
+    (setq alias (buffer-substring-no-properties old-point (1- (point))))
+    (search-forward-regexp "[^ \t]" nil t)
+    (setq expansion (buffer-substring-no-properties (1- (point)) end-point))
+    (setf (point) old-point)
+    (cons alias expansion)))
+
+(defun mutt-alias-expand (alias)
+  "Attempt to expand an alias."
+  (let ((expansion (assoc alias (mutt-alias-load-aliases))))
+    (when expansion
+      (cdr expansion))))
+
+(put 'mutt-alias-interactive 'lisp-indent-function 3)
+
+(defmacro mutt-alias-interactive (name alias expansion doc &rest body)
+  "Generate a function that asks for an alias.
+
+The alias is placed into variable named by ALIAS and places it into the
+variable named by EXPANSION. If there is an expansion BODY will be evaluated
+otherwise an error is reported. The function will be given a doc string of
+DOC."
+  `(defun ,name (,alias) ,doc
+     (interactive (list (completing-read "Alias: " (mutt-alias-load-aliases))))
+     (let ((,expansion (mutt-alias-expand ,alias)))
+       (if ,expansion
+           (progn
+             ,@body)
+         (error "Unknown alias \"%s\"" ,alias)))))
+
+(mutt-alias-interactive mutt-alias-insert alias expansion
+  "Insert the expansion for ALIAS into the current buffer."
+  (insert expansion))
+
+(mutt-alias-interactive mutt-alias-lookup alias expansion
+  "Lookup and display the expansion for ALIAS."
+  (message "%s: %s" alias expansion))
+
+(provide 'mutt-alias)
+
+;;; mutt-alias.el ends here
diff --git a/elisp/emacs-goodies-el/muttrc-mode.el b/elisp/emacs-goodies-el/muttrc-mode.el
new file mode 100755
index 0000000..9f249f7
--- /dev/null
+++ b/elisp/emacs-goodies-el/muttrc-mode.el
@@ -0,0 +1,1638 @@
+;;; muttrc-mode.el --- Major mode to edit muttrc under Emacs
+
+;;; Copyright (C) 2000, 2001, 2002 Laurent Pelecq
+;;; Copyright (C) 2009 Kumar Appaiah
+;;;
+;;; Authors: Laurent Pelecq 
+;;;          Kumar Appaiah 
+
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2, or (at your option)
+;;; any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;; Supported Emacs:
+;;; ================
+;;; This mode has only been tested on Emacs 21.2. If you
+;;; encounter problems with older versions or with Xemacs, let me
+;;; know.
+
+;;; Installation:
+;;; =============
+;;; Add this lines to your .emacs:
+;;;   (autoload 'muttrc-mode "muttrc-mode.el"
+;;;   	"Major mode to edit muttrc files" t)
+;;;   (setq auto-mode-alist
+;;;   	    (append '(("muttrc\\'" . muttrc-mode))
+;;;   		    auto-mode-alist))
+;;; Be sure this file is in a directory that appears in the load-path.
+;;;
+;;; You mail want to use this mode for other files like the mail
+;;; aliases file. In that case just add the following lines at the end
+;;; of these files:
+;;;   ### Local Variables: ***
+;;;   ### mode: muttrc ***
+;;;   ### End: ***
+
+;;; Customization:
+;;; ==============
+;;; Execute: M-x configure-group RET muttrc RET
+;;;
+;;; By default, help on command/variable is displayed automatically
+;;; while executing a command to modify them. Disable this feature if
+;;; you have problems with.
+
+;;; Description:
+;;; ============
+;;; This mode first goal is to provide syntax highlighting with
+;;; font-lock. The basic fontification appears on strings, comments,
+;;; command names and variables. Additional fontification for commands
+;;; arguments can be enabled through the customization buffer.
+;;;
+;;; Main commands are:
+;;; C-x c -- muttrc-insert-command
+;;; C-x s -- muttrc-set-variable
+;;; C-x S -- muttrc-unset-variable
+;;;
+;;; Type C-h m for all key bindings.
+
+;;; BUGS:
+;;; =====
+;;; - Multiline commands are not properly handled and can lead to
+;;;   unexpected result.
+
+
+
+;;; Code:
+
+;;; ------------------------------------------------------------
+;;; Requirement
+;;; ------------------------------------------------------------
+
+(require 'man)
+
+(defconst muttrc-mode-version "$Revision: 1.2 $")
+
+;;; ------------------------------------------------------------
+;;; Configurable stuff
+;;; ------------------------------------------------------------
+
+(defgroup muttrc nil
+  "Muttrc editing commands for Emacs."
+  :group 'files
+  :prefix "muttrc-")
+
+(defcustom muttrc-manual-path "/usr/share/doc/mutt/manual.txt.gz"
+  "Path to the Mutt manual."
+  :type 'string
+  :group 'muttrc)
+
+(defcustom muttrc-display-help t
+  "Display help for each command/variable modification if set."
+  :type 'boolean
+  :group 'muttrc)
+
+(defcustom muttrc-folder-abbrev ?+
+  "Character used to refer to the folder directory."
+  :type '(choice (const :tag "+" ?+)
+		 (const :tag "=" ?=))
+  :group 'muttrc)
+
+(defcustom muttrc-argument-faces-alist
+  '((alias . bold)
+    (address . default)
+    (face . default)
+    (color . default)
+    (command . default)
+    (path . default)
+    (function . default)
+    (header . default)
+    (hook . default)
+    (key . default)
+    (map . default)
+    (mimetype . default)
+    (object . default)
+    (regexp . default)
+    (sequence . default)
+    (string . default)
+    (hook-type . default))
+  "List of faces for the Muttrc command arguments. Standard faces are
+symbols like 'bold, 'underline, ... Muttrc files must be revisited in
+order for the modifications to take effect."
+  :type '(repeat (cons symbol symbol))
+  :group 'muttrc)
+
+;;; ------------------------------------------------------------
+;;; For backward compatibility
+;;; ------------------------------------------------------------
+
+(or (functionp 'match-string-no-properties)
+    (defalias 'match-string-no-properties 'match-string))
+
+;;; ------------------------------------------------------------
+;;; Mutt variables and commands
+;;; ------------------------------------------------------------
+
+(defconst muttrc-arg-handler-alist
+  '((alias muttrc-get-word "Alias")
+    (boolean muttrc-get-boolean "Enable")
+    (number muttrc-get-number "Number")
+    (address muttrc-get-string "Address")
+    (face muttrc-get-from-list "Face" muttrc-face-alist t)
+    (color muttrc-get-from-list "Color" muttrc-color-alist)
+    (command muttrc-get-command "Command")
+    (statement muttrc-get-statement "Command")
+    (assignment muttrc-get-assignment "Variable" t)
+    (variable muttrc-get-assignment "Variable" nil)
+    (path muttrc-get-path "Path")
+    (function muttrc-get-from-list "Function" muttrc-mutt-function-alist)
+    (header muttrc-get-from-list "Header name" muttrc-header-alist)
+    (hook-type muttrc-get-from-list "Hook" muttrc-hook-alist t)
+    (key muttrc-get-string "Key")
+    (map muttrc-get-from-list "Map" muttrc-map-alist t)
+    (mimetype muttrc-get-from-list "MIME type" muttrc-mimetype-alist)
+    (object muttrc-get-from-list "Object" muttrc-object-alist)
+    (regexp muttrc-get-string "Regular expression")
+    (sequence muttrc-get-string "Sequence")
+    (string muttrc-get-string "String")
+    (alias-sort-order muttrc-get-from-list "Sort order"
+		      muttrc-alias-sort-order-alist)
+    (aux-sort-order  muttrc-get-from-list "Sort order"
+		    muttrc-aux-sort-order-alist)
+    (browser-sort-order muttrc-get-from-list "Sort order"
+			muttrc-browser-sort-order-alist)
+    (pgp-sort-order muttrc-get-from-list "Sort order"
+		    muttrc-pgp-sort-order-alist)
+    (quadoption muttrc-get-from-list "Option" muttrc-quadoption-alist)
+    (sort-order muttrc-get-from-list "Sort order"
+		muttrc-sort-order-alist))
+  "List of handler for each type of argument. The format is:
+\(ARG-TYPE FACE HANDLER PROMPT HANDLER-ARGS\).
+The PROMPT can be overwritten by in command description.")
+
+(defconst muttrc-face-alist
+  '(("none" . 1) ("bold" . 2) ("underline" . 3)
+    ("reverse" . 4) ("standout". 5)))
+
+(defconst muttrc-color-alist
+  '(("default" . 0)
+    ("black" . 1) ("blue" . 2) ("cyan" . 3) ("green" . 4)
+    ("magenta" . 5) ("red" . 6) ("white" . 7) ("yellow" . 8)
+    ("brightdefault" . 9)
+    ("brightblack" . 10) ("brightblue" . 11) ("brightcyan" . 12)
+    ("brightgreen" . 13) ("brightmagenta" . 14) ("brightred" . 15)
+    ("brightwhite" . 16) ("brightyellow" . 17)))
+
+(defconst muttrc-object-alist
+  '(("attachment" . 0)
+    ("body" . 1)
+    ("bold" . 2)
+    ("error" . 3)
+    ("hdrdefault" . 4)
+    ("header" . 5)
+    ("index" . 6)
+    ("indicator" . 7)
+    ("markers" . 8)
+    ("message" . 9)
+    ("normal" . 10)
+    ("quoted" . 11)
+    ("search" . 12)
+    ("signature" . 13)
+    ("status" . 14)
+    ("tilde" . 15)
+    ("tree" . 16)
+    ("underline" . 17))
+  "Mutt object on which color apply.")
+
+(defconst muttrc-header-alist
+  '(("content-transfer-encoding" . 0)
+    ("content-type" . 1)
+    ("date" . 2)
+    ("from" . 3)
+    ("message-id" . 4)
+    ("mime-version" . 5)
+    ("organization" . 6)
+    ("received" . 7)
+    ("reply-to" . 8)
+    ("resent-from" . 9)
+    ("subject" . 10)
+    ("to" . 11)
+    ("x-accept-language" . 12)
+    ("x-mailer" . 13)
+    ("x-mimetrack" . 14)
+    ("x-sender" . 15)))
+
+(defconst muttrc-hook-alist
+  '(("folder-hook" . 0) ("send-hook" . 1) ("save-hook" . 2)
+    ("mbox-hook" . 3) ("fcc-hook" . 4) ("fcc-save-hook" . 5)
+    ("message-hook" . 5) ("charset-hook" . 6) ("iconv-hook" . 7)
+    ("account-hook" . 8) ("append-hook" . 9) ("close-hook" . 10)
+    ("crypt-hook" . 11) ("send2-hook" . 12) ("reply-hook" . 13)
+    ("open-hook" . 14)))
+
+(defconst muttrc-map-alist
+  '(("alias" . 0) ("attach" . 1) ("browser" . 2) ("compose" . 3)
+    ("editor" . 4) ("generic" . 5) ("index" . 6) ("pager" . 7)
+    ("pgp" . 8) ("postpone" . 9) ("query" . 10)))
+
+(defconst muttrc-mimetype-alist
+  '(("application/andrew-inset" "ez")
+    ("application/excel" "xls")
+    ("application/fractals" "fif")
+    ("application/java-archive" "jar")
+    ("application/mac-binhex40" "hqx")
+    ("application/msword" "doc" "dot")
+    ("application/octet-stream" "exe" "bin")
+    ("application/oda" "oda")
+    ("application/pdf" "pdf")
+    ("application/pdf")
+    ("application/pgp" "pgp")
+    ("application/postscript" "ai" "eps" "ps" "PS")
+    ("application/pre-encrypted" "enc")
+    ("application/rtf" "rtf")
+    ("application/vnd.lotus-wordpro" "lwp" "sam")
+    ("application/vnd.ms-access" "mdb" "mda" "mde")
+    ("application/vnd.ms-excel" "xls")
+    ("application/vnd.ms-powerpoint" "ppt" "pot" "ppa" "pps" "pwz")
+    ("application/vnd.ms-schedule" "scd" "sch" "sc2")
+    ("application/wordperfect5.1" "wpd" "wp6")
+    ("application/x-arj-compressed" "arj")
+    ("application/x-bcpio" "bcpio")
+    ("application/x-chess-pgn" "pgn")
+    ("application/x-cpio" "cpio")
+    ("application/x-csh" "csh")
+    ("application/x-debian-package" "deb")
+    ("application/x-dvi" "dvi")
+    ("application/x-fortezza-ckl" "ckl")
+    ("application/x-gtar" "gtar")
+    ("application/x-gunzip" "gz")
+    ("application/x-hdf" "hdf")
+    ("application/x-javascript" "js" "mocha")
+    ("application/x-javascript-config" "jsc")
+    ("application/x-latex" "latex")
+    ("application/x-mif" "mif")
+    ("application/x-msdos-program" "com" "exe" "bat")
+    ("application/x-netcdf" "cdf" "nc")
+    ("application/x-ns-proxy-autoconfig" "pac")
+    ("application/x-ns-proxy-autoconfig")
+    ("application/x-perl" "pl" "pm")
+    ("application/x-pkcs7-crl" "crl")
+    ("application/x-pkcs7-mime" "p7m" "p7c")
+    ("application/x-pkcs7-signature" "p7s")
+    ("application/x-rar-compressed" "rar")
+    ("application/x-sh" "sh")
+    ("application/x-shar" "shar")
+    ("application/x-stuffit" "sit")
+    ("application/x-sv4cpio" "sv4cpio")
+    ("application/x-sv4crc" "sv4crc")
+    ("application/x-tar" "tar")
+    ("application/x-tar-gz" "tgz" "tar.gz")
+    ("application/x-tcl" "tcl")
+    ("application/x-tex" "tex")
+    ("application/x-texinfo" "texi" "texinfo")
+    ("application/x-troff" "t" "tr" "roff")
+    ("application/x-troff-man" "man")
+    ("application/x-troff-me" "me")
+    ("application/x-troff-ms" "ms")
+    ("application/x-ustar" "ustar")
+    ("application/x-wais-source" "src")
+    ("application/x-zip-compressed" "zip")
+    ("audio/basic" "au" "snd")
+    ("audio/basic" "snd")
+    ("audio/midi" "mid" "midi")
+    ("audio/ulaw" "au")
+    ("audio/x-aiff" "aif" "aifc" "aiff")
+    ("audio/x-aiff" "aif" "aiff" "aifc")
+    ("audio/x-wav" "wav")
+    ("image/gif" "gif")
+    ("image/ief" "ief")
+    ("image/jpeg" "jpe" "jpeg" "jpg")
+    ("image/png" "png")
+    ("image/tiff" "tif" "tiff")
+    ("image/tiff")
+    ("image/x-MS-bmp" "bmp")
+    ("image/x-cmu-raster" "ras")
+    ("image/x-photo-cd" "pcd")
+    ("image/x-portable-anymap" "pnm")
+    ("image/x-portable-bitmap" "pbm")
+    ("image/x-portable-graymap" "pgm")
+    ("image/x-portable-pixmap" "ppm")
+    ("image/x-rgb" "rgb")
+    ("image/x-xbitmap" "xbm")
+    ("image/x-xpixmap" "xpm")
+    ("image/x-xwindowdump" "xwd")
+    ("text/html" "html" "htm" "shtml")
+    ("text/plain" "txt" "text")
+    ("text/richtext" "rtx")
+    ("text/tab-separated-values" "tsv")
+    ("text/x-setext" "etx")
+    ("text/x-vcard" "vcf")
+    ("text/x-vcard")
+    ("video/dl" "dl")
+    ("video/fli" "fli")
+    ("video/gl" "gl")
+    ("video/mpeg" "mpeg" "mpg" "mpe" "mpv" "vbs" "mpegv")
+    ("video/quicktime" "qt" "mov" "moov")
+    ("video/x-msvideo" "avi")
+    ("video/x-sgi-movie" "movie")
+    ("x-world/x-vrml" "vrm" "vrml" "wrl")))
+
+(defconst muttrc-command-alist
+  '(
+    ("folder-hook"		((string) (statement)) nil nil)
+    ("alias"			((alias) (address)) t nil)
+    ("unalias"			((alias) (address)) t nil)
+    ("alternative_order"	((mimetype)) t nil)
+    ("auto_view"		((mimetype)) t nil)
+    ("bind"			((map) (key) (function)) nil t)
+    ("color"			((object)
+				 (color "Foreground")
+				 (color "Background")
+				 (regexp)) nil t)
+    ("charset-hook"		((string "Alias")
+				 (string "Charset")) nil nil)
+    ("fcc-hook"			((regexp) (path)) nil nil)
+    ("fcc-save-hook"		((regexp) (path)) nil nil)
+    ("folder-hook"		((regexp) (statement)) nil nil)
+    ("ignore"			((header)) t nil)
+    ("iconv-hook"		((string "Charset")
+				 (string "Local charset")) nil nil)
+    ("unignore"			((header)) t nil)
+    ("hdr_order"		((header)) t nil)
+    ("unhdr_order"		((header)) t nil)
+    ("lists"			((address)) t nil)
+    ("unlists"			((address)) t nil)
+    ("macro"			((map) (key) (sequence)
+				 (string "Description")) nil t)
+    ("mailboxes"		((path)) t nil)
+    ("mono"			((object) (face) (regexp)) nil t)
+    ("mbox-hook"		((regexp) (path)) nil nil)
+    ("message-hook"		((regexp) (statement)) nil nil)
+    ("my_hdr"			((string "Header")) nil nil)
+    ("unmy_hdr"			((header)) t nil)
+    ("push"			((string)) nil nil)
+    ("pgp-hook"			((regexp)
+				 (string "Keyid")) nil nil)
+    ("save-hook"		((regexp) (path)) nil nil)
+    ("score"			((regexp)
+				 (number "Value")) nil nil)
+    ("unscore"			((regexp)) t nil)
+    ("send-hook"		((regexp) (statement)) nil nil)
+    ("source"			((path)) nil nil)
+    ("subscribe"		((address)) t nil)
+    ("unsubscribe"		((address)) t nil)
+    ("unhook"			((hook-type)) nil nil)
+    ("alternates"		((regexp)) nil nil)
+    ("unalternates"		((regexp)) nil nil))
+  "List of muttrc commands with their arguments. Format is:
+COMMAND '\(ARG1 ARG2 ...\) REPEAT OPTIONAL
+REPEAT and OPTIONAL apply to the last argument.
+ARGn is the list of arguments for muttrc-call-arg-handler. Each args
+is a list \(ARGTYPE \[ARGNAME\]\).")
+
+(defconst muttrc-statement-alist
+  (append
+   '(("set"			((assignment)) t nil)
+     ("unset"			((variable)) t nil))
+   muttrc-command-alist)
+  "Additional muttrc commands with their arguments that are handled
+differently. See muttrc-command-alist")
+
+
+(defconst muttrc-variables-alist
+  '(("abort_nosubject" quadoption "ask-yes")
+    ("abort_unmodified" quadoption "yes")
+    ("alias_file" path "~/.muttrc")
+    ("alias_format" string "%4n %2f %t %-10a   %r")
+    ("allow_8bit" boolean t)
+    ("allow_ansi" boolean nil)
+    ("arrow_cursor" boolean nil)
+    ("ascii_chars" boolean nil)
+    ("askbcc" boolean nil)
+    ("askcc" boolean nil)
+    ("assumed_charset" string "us-ascii")
+    ("attach_format" string "%u%D%I %t%4n %T%.40d%> [%.7m/%.10M, %.6e%?C?, %C?, %s] ")
+    ("attach_sep" string "\\n")
+    ("attach_split" boolean t)
+    ("attribution" string "On %d, %n wrote:")
+    ("autoedit" boolean nil)
+    ("auto_tag" boolean nil)
+    ("beep" boolean t)
+    ("beep_new" boolean nil)
+    ("bounce" quadoption "ask-yes")
+    ("bounce_delivered" boolean t)
+    ("braille_friendly" boolean nil)
+    ("charset" string "")
+    ("check_new" boolean t)
+    ("collapse_unread" boolean t)
+    ("uncollapse_jump" boolean nil)
+    ("compose_format" string "-- Mutt: Compose  [Approx. msg size: %l   Atts: %a]%>-")
+    ("config_charset" string "")
+    ("confirmappend" boolean t)
+    ("confirmcreate" boolean t)
+    ("connect_timeout" number 30)
+    ("content_type" string "text/plain")
+    ("copy" quadoption "yes")
+    ("crypt_use_gpgme" boolean nil)
+    ("crypt_autopgp" boolean t)
+    ("crypt_autosmime" boolean t)
+    ("date_format" string "!%a, %b %d, %Y at %I:%M:%S%p %Z")
+    ("default_hook" string "~f %s !~P | (~P ~C %s)")
+    ("delete" quadoption "ask-yes")
+    ("delete_untag" boolean t)
+    ("digest_collapse" boolean t)
+    ("display_filter" path "")
+    ("dotlock_program" path "/usr/bin/mutt_dotlock")
+    ("dsn_notify" string "")
+    ("dsn_return" string "")
+    ("duplicate_threads" boolean t)
+    ("edit_headers" boolean nil)
+    ("editor" path "")
+    ("encode_from" boolean nil)
+    ("envelope_from_address" e-mail "")
+    ("escape" string "~")
+    ("fast_reply" boolean nil)
+    ("fcc_attach" boolean t)
+    ("fcc_clear" boolean nil)
+    ("file_charset" string "")
+    ("folder" path "~/Mail")
+    ("folder_format" string "%2C %t %N %F %2l %-8.8u %-8.8g %8s %d %f")
+    ("followup_to" boolean t)
+    ("force_name" boolean nil)
+    ("forward_decode" boolean t)
+    ("forward_edit" quadoption "yes")
+    ("forward_format" string "[%a: %s]")
+    ("forward_quote" boolean nil)
+    ("from" e-mail "")
+    ("gecos_mask" regular "^[^,]*")
+    ("hdrs" boolean t)
+    ("header" boolean nil)
+    ("help" boolean t)
+    ("hidden_host" boolean nil)
+    ("hide_limited" boolean nil)
+    ("hide_missing" boolean t)
+    ("hide_thread_subject" boolean t)
+    ("hide_top_limited" boolean nil)
+    ("hide_top_missing" boolean t)
+    ("history" number 10)
+    ("honor_followup_to" quadoption "yes")
+    ("hostname" string "")
+    ("ignore_list_reply_to" boolean nil)
+    ("imap_authenticators" string "")
+    ("imap_check_subscribed" boolean nil)
+    ("imap_delim_chars" string "/.")
+    ("imap_headers" string "")
+    ("imap_home_namespace" string "")
+    ("imap_idle" boolean nil)
+    ("imap_keepalive" number 900)
+    ("imap_list_subscribed" boolean nil)
+    ("imap_login" string "")
+    ("imap_pass" string "")
+    ("imap_passive" boolean t)
+    ("imap_peek" boolean t)
+    ("imap_servernoise" boolean t)
+    ("imap_user" string "")
+    ("implicit_autoview" boolean nil)
+    ("include" quadoption "ask-yes")
+    ("include_onlyfirst" boolean nil)
+    ("indent_string" string "> ")
+    ("index_format" string "%4C %Z %{%b %d} %-15.15L (%?l?%4l&%4c?) %s")
+    ("hdr_format" string "%4C %Z %{%b %d} %-15.15L (%?l?%4l&%4c?) %s")
+    ("ispell" path "ispell")
+    ("keep_flagged" boolean nil)
+    ("locale" string "C")
+    ("mail_check" number 5)
+    ("mailcap_path" string "")
+    ("mailcap_sanitize" boolean t)
+    ("maildir_mtime" boolean nil)
+    ("header_cache" path "")
+    ("maildir_header_cache_verify" boolean t)
+    ("header_cache_pagesize" string "16384")
+    ("maildir_trash" boolean nil)
+    ("mark_old" boolean t)
+    ("markers" boolean t)
+    ("mask" regular "!^\.[^.]")
+    ("mbox" path "~/mbox")
+    ("mbox_type" folder mbox)
+    ("metoo" boolean nil)
+    ("menu_context" number 0)
+    ("menu_move_off" boolean t)
+    ("menu_scroll" boolean nil)
+    ("meta_key" boolean nil)
+    ("mh_purge" boolean nil)
+    ("mh_seq_flagged" string "flagged")
+    ("mh_seq_replied" string "replied")
+    ("mh_seq_unseen" string "unseen")
+    ("mime_forward" quadoption "no")
+    ("mime_forward_decode" boolean nil)
+    ("mime_forward_rest" quadoption "yes")
+    ("pgp_mime_signature_filename" string "signature.asc")
+    ("pgp_mime_signature_description" string "Digital signature")
+    ("mix_entry_format" string "%4n %c %-16s %a")
+    ("mixmaster" path "mixmaster")
+    ("move" quadoption "ask-no")
+    ("message_cachedir" path "")
+    ("message_format" string "%s")
+    ("narrow_tree" boolean nil)
+    ("net_inc" number 10)
+    ("pager" path "builtin")
+    ("pager_context" number 0)
+    ("pager_format" string "-%Z- %C/%m: %-20.20n   %s")
+    ("pager_index_lines" number 0)
+    ("pager_stop" boolean nil)
+    ("crypt_autosign" boolean nil)
+    ("crypt_autoencrypt" boolean nil)
+    ("pgp_ignore_subkeys" boolean t)
+    ("crypt_replyencrypt" boolean t)
+    ("crypt_replysign" boolean nil)
+    ("crypt_replysignencrypted" boolean nil)
+    ("crypt_timestamp" boolean t)
+    ("pgp_use_gpg_agent" boolean nil)
+    ("crypt_verify_sig" quadoption "yes")
+    ("pgp_verify_sig" quadoption "yes")
+    ("smime_is_default" boolean nil)
+    ("smime_ask_cert_label" boolean t)
+    ("smime_decrypt_use_default_key" boolean t)
+    ("pgp_entry_format" string "%4n %t%f %4l/0x%k %-4a %2c %u")
+    ("pgp_good_sign" regular "")
+    ("pgp_check_exit" boolean t)
+    ("pgp_long_ids" boolean nil)
+    ("pgp_retainable_sigs" boolean nil)
+    ("pgp_autoinline" boolean nil)
+    ("pgp_replyinline" boolean nil)
+    ("pgp_show_unusable" boolean t)
+    ("pgp_sign_as" string "")
+    ("pgp_strict_enc" boolean t)
+    ("pgp_timeout" number 300)
+    ("pgp_sort_keys" sort address)
+    ("pgp_mime_auto" quadoption "ask-yes")
+    ("pgp_auto_decode" boolean nil)
+    ("pgp_decode_command" string "")
+    ("pgp_getkeys_command" string "")
+    ("pgp_verify_command" string "")
+    ("pgp_decrypt_command" string "")
+    ("pgp_clearsign_command" string "")
+    ("pgp_sign_command" string "")
+    ("pgp_encrypt_sign_command" string "")
+    ("pgp_encrypt_only_command" string "")
+    ("pgp_import_command" string "")
+    ("pgp_export_command" string "")
+    ("pgp_verify_key_command" string "")
+    ("pgp_list_secring_command" string "")
+    ("pgp_list_pubring_command" string "")
+    ("forward_decrypt" boolean t)
+    ("smime_timeout" number 300)
+    ("smime_encrypt_with" string "")
+    ("smime_keys" path "")
+    ("smime_ca_location" path "")
+    ("smime_certificates" path "")
+    ("smime_decrypt_command" string "")
+    ("smime_verify_command" string "")
+    ("smime_verify_opaque_command" string "")
+    ("smime_sign_command" string "")
+    ("smime_sign_opaque_command" string "")
+    ("smime_encrypt_command" string "")
+    ("smime_pk7out_command" string "")
+    ("smime_get_cert_command" string "")
+    ("smime_get_signer_cert_command" string "")
+    ("smime_import_cert_command" string "")
+    ("smime_get_cert_email_command" string "")
+    ("smime_default_key" string "")
+    ("ssl_force_tls" boolean nil)
+    ("ssl_starttls" quadoption "yes")
+    ("certificate_file" path "~/.mutt_certificates")
+    ("ssl_use_sslv3" boolean t)
+    ("ssl_use_tlsv1" boolean t)
+    ("ssl_min_dh_prime_bits" number 0)
+    ("ssl_ca_certificates_file" path "")
+    ("pipe_split" boolean nil)
+    ("pipe_decode" boolean nil)
+    ("pipe_sep" string "\\n")
+    ("pop_authenticators" string "")
+    ("pop_auth_try_all" boolean t)
+    ("pop_checkinterval" number 60)
+    ("pop_delete" quadoption "ask-no")
+    ("pop_host" string "")
+    ("pop_last" boolean nil)
+    ("pop_reconnect" quadoption "ask-yes")
+    ("pop_user" string "")
+    ("pop_pass" string "")
+    ("post_indent_string" string "")
+    ("postpone" quadoption "ask-yes")
+    ("postponed" path "~/postponed")
+    ("preconnect" string "")
+    ("print" quadoption "ask-no")
+    ("print_command" path "lpr")
+    ("print_decode" boolean t)
+    ("print_split" boolean nil)
+    ("prompt_after" boolean t)
+    ("query_command" path "")
+    ("quit" quadoption "yes")
+    ("quote_regexp" regular "^([ \t]*[|>:}#])+")
+    ("read_inc" number 10)
+    ("read_only" boolean nil)
+    ("realname" string "")
+    ("recall" quadoption "ask-yes")
+    ("record" path "~/sent")
+    ("reply_regexp" regular "^(re([\[0-9\]+])*|aw):[ \t]*")
+    ("reply_self" boolean nil)
+    ("reply_to" quadoption "ask-yes")
+    ("resolve" boolean t)
+    ("reverse_alias" boolean nil)
+    ("reverse_name" boolean nil)
+    ("reverse_realname" boolean t)
+    ("rfc2047_parameters" boolean nil)
+    ("save_address" boolean nil)
+    ("save_empty" boolean t)
+    ("save_name" boolean nil)
+    ("score" boolean t)
+    ("score_threshold_delete" number -1)
+    ("score_threshold_flag" number 9999)
+    ("score_threshold_read" number -1)
+    ("send_charset" string "us-ascii:iso-8859-1:utf-8")
+    ("sendmail" path "/usr/sbin/sendmail -oem -oi")
+    ("sendmail_wait" number 0)
+    ("shell" path "")
+    ("sig_dashes" boolean t)
+    ("sig_on_top" boolean nil)
+    ("signature" path "~/.signature")
+    ("simple_search" string "~f %s | ~s %s")
+    ("smart_wrap" boolean t)
+    ("smileys" regular "(>From )|(:[-^]?[][)(><}{|/DP])")
+    ("sleep_time" number 1)
+    ("sort" sort date)
+    ("sort_alias" sort alias)
+    ("sort_aux" sort date)
+    ("sort_browser" sort alpha)
+    ("sort_re" boolean t)
+    ("spam_separator" string ",")
+    ("spoolfile" path "")
+    ("status_chars" string "-*%A")
+    ("status_format" string "-%r-Mutt: %f [Msgs:%?M?%M/?%m%?n? New:%n?%?o? Old:%o?%?d? Del:%d?%?F? Flag:%F?%?t? Tag:%t?%?p? Post:%p?%?b? Inc:%b?%?l? %l?]---(%s/%S)-%>-(%P)---")
+    ("status_on_top" boolean nil)
+    ("strict_mime" boolean t)
+    ("strict_threads" boolean nil)
+    ("suspend" boolean t)
+    ("text_flowed" boolean nil)
+    ("thread_received" boolean nil)
+    ("thorough_search" boolean nil)
+    ("tilde" boolean nil)
+    ("timeout" number 600)
+    ("tmpdir" path "")
+    ("to_chars" string " +TCFL")
+    ("tunnel" string "")
+    ("use_8bitmime" boolean nil)
+    ("use_domain" boolean t)
+    ("use_envelope_from" boolean nil)
+    ("use_from" boolean t)
+    ("use_idn" boolean t)
+    ("use_ipv6" boolean t)
+    ("user_agent" boolean t)
+    ("visual" path "")
+    ("wait_key" boolean t)
+    ("weed" boolean t)
+    ("wrap_search" boolean t)
+    ("wrapmargin" number 0)
+    ("write_inc" number 10)
+    ("write_bcc" boolean t)
+    ("xterm_icon" string "M%?n?AIL&ail?")
+    ("xterm_set_titles" boolean nil)
+    ("xterm_title" string "Mutt with %?m?%m messages&no messages?%?n? [%n NEW]?"))
+  "List of muttrc variables. Format is:
+VARIABLE TYPE DEFAULT"
+  )
+
+(defconst muttrc-mutt-function-alist
+  '(("attach-file" . 0)
+    ("attach-key" . 1)
+    ("attach-message" . 2)
+    ("backspace" . 3)
+    ("backward-char" . 4)
+    ("bol" . 5)
+    ("bottom-page" . 6)
+    ("bounce-message" . 7)
+    ("buffy-cycle" . 8)
+    ("change-dir" . 9)
+    ("change-folder" . 10)
+    ("change-folder-readonly" . 11)
+    ("check-new" . 12)
+    ("clear-flag" . 13)
+    ("complete" . 14)
+    ("complete-query" . 15)
+    ("copy-file" . 16)
+    ("copy-message" . 17)
+    ("create-alias" . 18)
+    ("current-bottom" . 19)
+    ("current-middle" . 20)
+    ("current-top" . 21)
+    ("decode-copy" . 22)
+    ("decode-save" . 23)
+    ("delete-char" . 24)
+    ("delete-entry" . 25)
+    ("delete-message" . 26)
+    ("delete-pattern" . 27)
+    ("delete-subthread" . 28)
+    ("delete-thread" . 29)
+    ("detach-file" . 30)
+    ("display-address" . 31)
+    ("display-message" . 32)
+    ("display-toggle-weed" . 33)
+    ("edit" . 34)
+    ("edit-bcc" . 35)
+    ("edit-cc" . 36)
+    ("edit-description" . 37)
+    ("edit-encoding" . 38)
+    ("edit-fcc" . 39)
+    ("edit-file" . 40)
+    ("edit-from" . 41)
+    ("edit-headers" . 42)
+    ("edit-message" . 43)
+    ("edit-mime" . 44)
+    ("edit-reply-to" . 45)
+    ("edit-subject" . 46)
+    ("edit-to" . 47)
+    ("edit-type" . 48)
+    ("enter-command" . 49)
+    ("enter-mask" . 50)
+    ("eol" . 51)
+    ("exit" . 52)
+    ("extract-keys" . 53)
+    ("fetch-mail" . 54)
+    ("filter-entry" . 55)
+    ("first-entry" . 56)
+    ("flag-message" . 57)
+    ("forget-passphrase" . 58)
+    ("forward-char" . 59)
+    ("forward-message" . 60)
+    ("group-reply" . 61)
+    ("half-down" . 62)
+    ("half-up" . 63)
+    ("help" . 64)
+    ("history-down" . 65)
+    ("history-up" . 66)
+    ("ispell" . 67)
+    ("jump" . 68)
+    ("kill-eol" . 69)
+    ("kill-line" . 70)
+    ("kill-word" . 71)
+    ("last-entry" . 72)
+    ("limit" . 73)
+    ("list-reply" . 74)
+    ("mail" . 75)
+    ("mail-key" . 76)
+    ("mark-as-new" . 77)
+    ("middle-page" . 78)
+    ("new-mime" . 79)
+    ("next-entry" . 80)
+    ("next-line" . 81)
+    ("next-new" . 82)
+    ("next-page" . 83)
+    ("next-subthread" . 84)
+    ("next-thread" . 85)
+    ("next-undeleted" . 86)
+    ("next-unread" . 87)
+    ("parent-message" . 88)
+    ("pgp-menu" . 89)
+    ("pipe-entry" . 90)
+    ("pipe-message" . 91)
+    ("postpone-message" . 92)
+    ("previous-entry" . 93)
+    ("previous-line" . 94)
+    ("previous-new" . 95)
+    ("previous-page" . 96)
+    ("previous-subthread" . 97)
+    ("previous-thread" . 98)
+    ("previous-undeleted" . 99)
+    ("previous-unread" . 100)
+    ("print-entry" . 101)
+    ("print-message" . 102)
+    ("query" . 103)
+    ("query-append" . 104)
+    ("quit" . 105)
+    ("quote-char" . 106)
+    ("read-subthread" . 107)
+    ("read-thread" . 108)
+    ("recall-message" . 109)
+    ("redraw-screen" . 110)
+    ("refresh" . 111)
+    ("rename-file" . 112)
+    ("reply" . 113)
+    ("save-entry" . 114)
+    ("save-message" . 115)
+    ("search" . 116)
+    ("search-next" . 117)
+    ("search-opposite" . 118)
+    ("search-reverse" . 119)
+    ("search-toggle" . 120)
+    ("select-entry" . 121)
+    ("select-new" . 122)
+    ("send-message" . 123)
+    ("set-flag" . 124)
+    ("shell-escape" . 125)
+    ("show-limit" . 126)
+    ("show-version" . 127)
+    ("skip-quoted" . 128)
+    ("sort" . 129)
+    ("sort-mailbox" . 130)
+    ("sort-reverse" . 131)
+    ("subscribe" . 132)
+    ("sync-mailbox" . 133)
+    ("tag-entry" . 134)
+    ("tag-message" . 135)
+    ("tag-pattern" . 136)
+    ("tag-prefix" . 137)
+    ("tag-thread" . 138)
+    ("toggle-mailboxes" . 139)
+    ("toggle-new" . 140)
+    ("toggle-quoted" . 141)
+    ("toggle-subscribed" . 142)
+    ("toggle-unlink" . 143)
+    ("toggle-write" . 144)
+    ("top" . 145)
+    ("top-page" . 146)
+    ("undelete-entry" . 147)
+    ("undelete-message" . 148)
+    ("undelete-pattern" . 149)
+    ("undelete-subthread" . 150)
+    ("undelete-thread" . 151)
+    ("unsubscribe" . 152)
+    ("untag-pattern" . 153)
+    ("verify-key" . 154)
+    ("view-attach" . 155)
+    ("view-attachments" . 156)
+    ("view-file" . 157)
+    ("view-mailcap" . 158)
+    ("view-name" . 159)
+    ("view-text" . 160)
+    ("write-fcc" . 161))
+  "List of Mutt command (not muttrc!)")
+
+(defconst muttrc-alias-sort-order-alist
+  '(("address" . 0) ("alias" . 1)  ("unsorted" . 2)))
+
+(defconst muttrc-aux-sort-order-alist
+  '(("date-sent" . 0) ("reverse-date-sent" . 1) ("last-date-sent" . 2)
+    ("date-received" . 3) ("reverse-date-received" . 4)
+    ("last-date-received" . 5)
+    ("from" . 6) ("reverse-from" . 7) ("last-from" . 8)
+    ("mailbox-order" . 9) ("reverse-mailbox-order" . 10)
+    ("last-mailbox-order" . 11)
+    ("score" . 12) ("reverse-score" . 13) ("last-score" . 14)
+    ("size" . 15) ("reverse-size" . 16) ("last-size" . 17)
+    ("subject" . 18) ("reverse-subject" . 19) ("last-subject" . 20)
+    ("threads" . 21) ("reverse-threads" . 22) ("last-threads" . 23)
+    ("to" . 24) ("reverse-to" . 25) ("last-to" . 26)))
+
+(defconst muttrc-browser-sort-order-alist
+  '(("alpha" . 0) ("date" . 1) ("size" . 2) ("unsorted" . 3)))
+
+(defconst muttrc-pgp-sort-order-alist
+  '(("address" . 0) ("date" . 1) ("keyid" . 2)
+    ("reverse-address" . 3) ("reverse-date" . 4)
+    ("reverse-keyid" . 5) ("reverse-trust" . 6)
+    ("trust" . 7)))
+
+(defconst muttrc-quadoption-alist
+  '(("yes" .0) ("no" .1) ("ask-yes" .2) ("ask-no" .3)))
+
+(defconst muttrc-sort-order-alist
+  '(("date-sent" . 0) ("reverse-date-sent" . 1)
+    ("date-received" . 2) ("reverse-date-received" . 3)
+    ("from" . 4) ("reverse-from" . 5)
+    ("mailbox-order" . 6) ("reverse-mailbox-order" . 7)
+    ("score" . 8) ("reverse-score" . 9)
+    ("size" . 10) ("reverse-size" . 11)
+    ("subject" . 12) ("reverse-subject" . 13)
+    ("threads" . 14) ("reverse-threads" . 15)
+    ("to" . 16) ("reverse-to" . 17)))
+
+;;; ------------------------------------------------------------
+;;; Font-lock definitions
+;;; ------------------------------------------------------------
+
+(defun muttrc-string-regexp (quote-char)
+  (let ((c (char-to-string quote-char)))
+    (format "%s\\([^\n%s]\\|[\\].\\)*%s" c c c)))
+
+(defvar muttrc-generic-arg-regexp
+  (concat "\\("
+	  (muttrc-string-regexp ?\")
+	  "\\|"
+	  "'\\([^']*\\)'"
+	  "\\|"
+	  (muttrc-string-regexp ?\`)
+	  "\\|"
+	  "\\([^\n\t \"'`#;\\]\\|[\\].\\)+"
+	  "\\)"))
+
+(defvar muttrc-generic-arg-sequence-regexp
+  (concat "\\(\\s-*" muttrc-generic-arg-regexp "+\\)*"))
+
+(defvar muttrc-non-command-keyword-regexp
+  "\\(^\\|;\\)\\s-*\\<\\(set\\|unset\\|toggle\\|reset\\)\\>")
+
+(defvar muttrc-variable-regexp
+  (concat "\\<\\(\\(no\\|inv\\)?\\("
+	  (mapconcat 'car muttrc-variables-alist "\\|")
+	  "\\)\\)\\>"))
+
+(defvar muttrc-assignement-regexp
+  (concat muttrc-variable-regexp
+	  "\\s-*\\(=\\s-*" muttrc-generic-arg-regexp "\\)?"))
+
+(defun muttrc-search-command-forward (command &optional limit)
+  (let ((cmd-desc (assoc command muttrc-command-alist)))
+    (if cmd-desc
+	(let ((cmd-match-data '())
+	      (cmd-args (cadr cmd-desc))
+	      (origin (point))
+	      beg-0 end-0)
+	  (catch 'done
+	    (while (and (not cmd-match-data)
+			(re-search-forward
+			 (concat "\\(;\\|^\\)\\s-*\\(" command "\\)")
+			 limit t))
+	      (let ((beg (nth 4 (match-data)))
+		    (end (nth 5 (match-data))))
+		(setq beg-0 beg)
+		(setq cmd-match-data (list beg end)))
+	      (let ((args cmd-args))
+		(while args
+		  (let ((arg-type (caar args))
+			(arg-re (if (null (cdr args))
+				    muttrc-generic-arg-sequence-regexp
+				  muttrc-generic-arg-regexp)))
+		    (skip-syntax-forward "-")
+		    (if (looking-at arg-re)
+			(let ((beg (nth 0 (match-data)))
+			      (end (nth 1 (match-data))))
+			  (goto-char end)
+			  (setq cmd-match-data (append cmd-match-data
+						       (list beg end)))
+			  (setq end-0 end)
+			  (setq args (cdr args)))
+		      (progn
+			(setq args nil)
+			(setq cmd-match-data nil)))))
+		(when cmd-match-data
+		  (set-match-data (cons beg-0
+					(cons end-0
+					      cmd-match-data)))
+		  (throw 'done t))))
+	    (goto-char origin)
+	    nil)))))
+
+
+(defun muttrc-font-lock-keywords ()
+  (let ((command-alist muttrc-command-alist)
+	keywords)
+    (while command-alist
+      (let* ((cmd (caar command-alist))
+	     (args (cadr (car command-alist)))
+	     (regexp (eval ; Simulate a closure
+		      (list
+		       'lambda '(&optional limit)
+		       (list 'muttrc-search-command-forward cmd 'limit))))
+	     (hilighters '((1 font-lock-keyword-face)))
+	     (n 2))
+	(while args
+	  (let ((arg-type (caar args))
+		(last-arg-p (null (cdr args))))
+	    (setq hilighters
+		  (append hilighters
+			  (let ((face
+				 (or (cdr-safe
+				      (assoc arg-type
+					     muttrc-argument-faces-alist))
+				     'default)))
+			    (list (append (list n (list 'quote face))
+					  (if last-arg-p '(nil t))))))))
+	  (setq n (1+ n))
+	  (setq args (cdr args)))
+	(setq keywords (append keywords (list (cons regexp hilighters))))
+	(setq command-alist (cdr command-alist))))
+     (append keywords
+	     (list
+	      (list muttrc-non-command-keyword-regexp 2
+		    font-lock-keyword-face)
+	      (list muttrc-assignement-regexp 1
+		    font-lock-variable-name-face)))
+    ))
+
+;;; ------------------------------------------------------------
+;;; Mode specific customization
+;;; ------------------------------------------------------------
+
+(defconst muttrc-mode-map nil
+  "The keymap that is used in Muttrc mode.")
+(if (null muttrc-mode-map)
+    (setq muttrc-mode-map
+	  (let ((map (make-sparse-keymap))
+		(help-map (make-sparse-keymap))
+		(ctrl-c-map (make-sparse-keymap)))
+	    (define-key map "\C-c" ctrl-c-map)
+	    (define-key ctrl-c-map "c" 'muttrc-insert-command)
+	    (define-key ctrl-c-map "C" 'comment-region)
+	    (define-key ctrl-c-map "s" 'muttrc-set-variable)
+	    (define-key ctrl-c-map "S" 'muttrc-unset-variable)
+	    (define-key ctrl-c-map "f" 'muttrc-find-variable-in-buffer)
+	    (define-key ctrl-c-map "h" help-map)
+	    (define-key help-map "m" 'muttrc-find-manual-file)
+	    (define-key help-map "v" 'muttrc-find-variable-help)
+	    (define-key help-map "c" 'muttrc-find-command-help)
+	    map)))
+
+(defvar muttrc-mode-syntax-table nil)
+(when (null muttrc-mode-syntax-table)
+  (setq muttrc-mode-syntax-table (make-syntax-table))
+  (modify-syntax-entry ?#  "<     " muttrc-mode-syntax-table)
+  (modify-syntax-entry ?\n ">     " muttrc-mode-syntax-table)
+  (modify-syntax-entry ?\' "$     " muttrc-mode-syntax-table)
+  (modify-syntax-entry ?\' "$     " muttrc-mode-syntax-table)
+  (modify-syntax-entry ?_  "w     " muttrc-mode-syntax-table)
+  (modify-syntax-entry ?-  "w     " muttrc-mode-syntax-table)
+  )
+
+;;; ------------------------------------------------------------
+;;; The mode function itself.
+;;; ------------------------------------------------------------
+
+;;;###autoload
+(defun muttrc-mode ()
+  "Major mode for editing Muttrc files.
+This function ends by invoking the function(s) `muttrc-mode-hook'.
+
+\\{muttrc-mode-map}
+"
+
+  (interactive)
+  (kill-all-local-variables)
+
+  ;; Font lock.
+  (make-local-variable 'font-lock-defaults)
+  (setq font-lock-defaults
+	'('muttrc-font-lock-keywords
+	  nil nil nil nil
+	  (font-lock-syntactic-keywords . (("'[^'\n]*'" 0 "\"")))))
+
+  ;; Comment stuff.
+  (make-local-variable 'comment-start)
+  (setq comment-start "#")
+  (make-local-variable 'comment-end)
+  (setq comment-end "")
+  (make-local-variable 'comment-start-skip)
+  (setq comment-start-skip "#+[ \t]*")
+
+  ;; become the current major mode
+  (setq major-mode 'muttrc-mode)
+  (setq mode-name "Muttrc")
+
+  ;; Activate keymap and syntax table.
+  (use-local-map muttrc-mode-map)
+  (set-syntax-table muttrc-mode-syntax-table)
+
+  (run-hooks 'muttrc-mode-hook))
+
+
+
+;;; ------------------------------------------------------------
+;;; Other functions
+;;; ------------------------------------------------------------
+
+(defun muttrc-perform-nonreg-test ()
+  (interactive)
+  (save-excursion
+    (goto-char (point-min))
+    (while (re-search-forward "^# Begin\\s-+\\(.*\\)$" nil t)
+      (let ((test-name (match-string-no-properties 1))
+	    (expr ""))
+	(catch 'loop
+	  (while t
+	    (or (= (forward-line 1) 0)
+		(throw 'loop t))
+	    (if (looking-at (format "^# End\\s-+%s\\s-*"
+				    (regexp-quote test-name)))
+		(throw 'loop t))
+	    (if (looking-at "^# End\\s-+\\(.*\\)$")
+		(error "Found end of %s before %s"
+		       (match-string-no-properties 1) test-name))
+	    (if (looking-at "^[^#]")
+		(error "End of %s not found" test-name))
+	    (if (looking-at "^#\\s-*\\(.*\\)$")
+		(setq expr (concat expr (match-string-no-properties 1))))))
+	(if (eval (read expr))
+	    (message "Passed: %s" test-name)
+	  (error "Failed: %s" test-name))))))
+
+(defun muttrc-quote-string (s)
+  "Add a backslash on quotes and surround by quotes if needed."
+  (save-match-data
+    (cond ((or (not s) (equal s "")) "''")
+	  ((string-match "^[^']*\\s-[^']*$" s) (format "'%s'" s))
+	  ((string-match "\\s-" s)
+	   (concat "\""
+		   (mapconcat (lambda (c)
+				(if (eq c ?\") "\\\""
+				  (char-to-string c)))
+			      s "")
+		   "\""))
+	  (t s))))
+
+(defun muttrc-prompt-string (prompt-base &optional default)
+  (if default
+      (format "%s [%s]: " prompt-base default)
+    (format "%s: " prompt-base)))
+
+(defun muttrc-token-around-point (alist &optional strip-fun)
+  (let ((word (and (functionp 'thing-at-point)
+		   (funcall (or strip-fun 'identity)
+			    (funcall 'thing-at-point 'word)))))
+    (if (and word (assoc word alist))
+	word)))
+
+(defun muttrc-assignement (varname modifier &optional value)
+  (concat (format "%s%s" (or modifier "") varname)
+	  (if (stringp value)
+	      (format "=%s"
+		      (muttrc-quote-string value))
+	    "")))
+
+(defun muttrc-split-next-set-line ()
+  "Returns the current line splitted into tokens. The result is a list
+of tokens like:
+\((CMD START END) ((VAR1 MODIFIER1 ASSIGNMENT1 START END) ... REST)).
+Last element REST is one string that is the rest of the line."
+  (if (re-search-forward
+       "^\\s-*\\(set\\|unset\\|toggle\\|reset\\)\\s-+" nil t)
+      (let ((line (list (list (match-string-no-properties 1)
+			      (match-beginning 1)
+			      (match-end 1))))
+	    (limit (save-excursion
+		     (end-of-line)
+		     (point))))
+	(catch 'done
+	  (while (< (point) limit)
+	    (or (looking-at
+		 (format "\\<\\(inv\\|no\\)?\\([a-z][a-z_]*\\)\\>"))
+		(throw 'done t))
+	    (let ((modifier (match-string-no-properties 1))
+		  (varname (match-string-no-properties 2))
+		  (assignment nil))
+	      (goto-char (match-end 0))
+	      (skip-syntax-forward "-" limit)
+	      (if (or (looking-at		; Set without quote
+		       "=\\s-*\\([^'\" \t\n#]+\\)")
+		      (looking-at		; Set with double quote (")
+		       "=\\s-*\"\\(\\([^\"\\]\\|\\\\.\\)*\\)\"")
+		      (looking-at		; Set with single quote (')
+		       "=\\s-*'\\([^']*\\)'"))
+		  (let ((type (let ((desc (assoc varname
+						 muttrc-variables-alist)))
+				(if desc (cadr desc)))))
+		    (if type
+			(and (eq type 'boolean)
+			     (message "%s: can't assign a boolean" varname))
+		      (message "%s: unknown Muttrc variable"
+			       varname))
+		    (setq assignment (match-string-no-properties 1))
+		    (goto-char (match-end 0))))
+	      (nconc line (list (list varname modifier
+				      assignment
+				      (match-beginning 0)
+				      (match-end 0))))
+	      (skip-syntax-forward "-" limit))))
+	(skip-syntax-backward "-")
+	(if (looking-at ".+$")
+	    (nconc line (list (list (match-string-no-properties 0)))))
+	(end-of-line)
+	line)))
+
+(defun muttrc-splice-assignment (line varname)
+  "Returns a list where assignements for VARNAME are separated from
+assignment for other variables."
+  (let ((l (cdr line))
+	(in '())
+	(out '()))
+    (while (and l (consp (car l)))
+      (let ((arg (car l)))
+	(if (string= (car arg) varname)
+	    (setq in (append in (list arg)))
+	  (setq out (append out (list arg)))))
+      (setq l (cdr l)))
+    (list in out)))
+
+(defun muttrc-new-value (cmd varname type modifier value default)
+  (if (eq type 'boolean)
+      (cond ((string= cmd "set")
+	     (cond ((null modifier) t)
+		   ((string= modifier "no") nil)
+		   ((string= modifier "inv") (not value))))
+	    ((string= cmd "unset")
+	     (cond ((null modifier) nil)
+		   ((string= modifier "no") t)
+		   ((string= modifier "inv") value)))
+	    ((string= cmd "toggle") (not value))
+	    ((string= cmd "reset")
+	     (cond ((null modifier) default)
+		   ((string= modifier "no") (not default))
+		   ((string= modifier "inv") (not default)))))
+      (cond ((string= cmd "set") value)
+	    ((string= cmd "unset") default)
+	    ((string= cmd "toggle")
+	     (error "%s: can't toggle non boolean" varname))
+	    ((string= cmd "reset") default))))
+
+(defun muttrc-get-value-and-point (varname)
+  "Fetch the value of VARIABLE from the current buffer. It returns a
+cons (VALUE . POINT) where POINT is the beginning of the line defining
+VARNAME."
+  (save-excursion
+    (let ((var-descriptor (assoc varname muttrc-variables-alist)))
+      (or var-descriptor
+	  (error "%s: unknown variable." varname))
+      (goto-char (point-min))
+      (let ((type (nth 0 (cdr var-descriptor)))
+	    (default (nth 1 (cdr var-descriptor)))
+	    (pos nil))
+	(let ((value default))
+	  ;; We search all the definitions in the buffer because some
+	  ;; users may use toggle or set inv...
+	  (catch 'done
+	    (while t
+	      (let ((line (muttrc-split-next-set-line)))
+		(or line (throw 'done t))
+		(let ((cmd (caar line))
+		      (assignments
+		       (car (muttrc-splice-assignment line varname))))
+		  (if assignments
+		      (setq pos (save-excursion
+				  (beginning-of-line)
+				  (point))))
+		  (while assignments
+		    (let ((modifier (nth 1 (car assignments)))
+			  (new-value (nth 2 (car assignments))))
+		      (setq value
+			    (muttrc-new-value cmd varname type modifier
+					      (or new-value value)
+					      default)))
+		    (setq assignments (cdr assignments)))))))
+	  (cons value pos))))))
+
+(defun muttrc-get-value (varname)
+  "Fetch the value of VARIABLE from the current buffer."
+  (let ((value (muttrc-get-value-and-point varname)))
+    (and value (car value))))
+
+;;; ------------------------------------------------------------
+;;; Viewing manual
+;;; ------------------------------------------------------------
+
+(defvar muttrc-manual-buffer-name "*Mutt Manual*")
+
+(defun muttrc-find-manual-file-no-select ()
+  "Convert overstriking and underlining to the correct fonts in a
+file. The buffer does not visit the file."
+  (interactive)
+  (or (file-readable-p muttrc-manual-path)
+      (error "%s: file not found" muttrc-manual-path))
+  (let ((buf (get-buffer-create muttrc-manual-buffer-name)))
+    (save-excursion
+      (set-buffer buf)
+      (if (not buffer-read-only)
+	  (let ((insert-contents-fun
+		 (condition-case nil
+		     (and (require 'jka-compr)
+			  'jka-compr-insert-file-contents)
+		   (error 'insert-file-contents))))
+	    (funcall insert-contents-fun muttrc-manual-path nil nil nil t)
+	    (buffer-disable-undo buf)
+	    (Man-fontify-manpage)
+	    (set-buffer-modified-p nil)
+	    (toggle-read-only)
+	    (goto-char (point-min))))
+      buf)))
+
+(defun muttrc-find-manual-file ()
+  "Convert overstriking and underlining to the correct fonts in a
+file. The buffer does not visit the file."
+  (interactive)
+  (switch-to-buffer-other-window
+   (muttrc-find-manual-file-no-select) t))
+
+(defun muttrc-search-command-help-forward (command)
+  (when (re-search-forward
+	 (format "^[ \t]*Usage:\\s-*\\(\\[un\\]\\)?%s" command)
+	 nil t)
+    (goto-char (match-beginning 0))
+    (forward-line -2)
+    (point)))
+
+(defun muttrc-search-variable-help-forward (command)
+  (when (and (re-search-forward
+	      (format "^[ \t]*%s\\.?\\s-*%s\\s-*$"
+		      "\\([1-9][0-9.]*\\)"
+		      (regexp-quote variable))
+	      nil t)
+	     (re-search-forward
+	      (format "^[ \t]*%s\\.?\\s-*%s\\s-*$"
+		      "\\([1-9][0-9.]*\\)"
+		      (regexp-quote variable))
+	      nil t)	     
+	     (re-search-forward
+	      (format "^[ \t]*%s\\.?\\s-*%s\\s-*$"
+		      (regexp-quote (match-string-no-properties 1))
+		      (regexp-quote variable))
+	      nil t))
+    (goto-char (match-beginning 0))
+    (point)))
+
+(defun muttrc-find-help (search-fun topic)
+  "Find an help topic in the manual and display it. Returns the manual
+buffer."
+  (let ((buf (muttrc-find-manual-file-no-select)))
+    (let ((win (get-buffer-window buf))
+	  help-start)
+      (save-excursion
+	(set-buffer buf)
+	(goto-char (point-min))
+	(or (funcall search-fun topic)
+	    (error "%s: entry not found in Mutt manual." command))
+	(setq help-start (point))
+	(unless (get-buffer-window buf)
+	  (switch-to-buffer-other-window buf t))
+	(set-window-start win help-start)))
+    buf))
+
+(defun muttrc-find-command-help (&optional command)
+  (interactive
+   (let ((word (muttrc-token-around-point muttrc-command-alist)))
+     (list (muttrc-get-from-list "Command" word 'muttrc-command-alist t))))
+  (muttrc-find-help 'muttrc-search-command-help-forward
+		    (if (string-match "^un\\(.*\\)$" command)
+			(match-string-no-properties 1 command)
+		      command)))
+
+(defun muttrc-find-variable-help (&optional variable)
+  (interactive
+   (list
+    (let ((word (muttrc-token-around-point
+		 muttrc-variables-alist
+		 (function
+		  (lambda (word)
+		    (if (and word
+			     (string-match "^\\(no\\|inv\\)\\(.*\\)$" word))
+			(match-string-no-properties 2 word)
+		      word))))))
+      (muttrc-get-from-list "Variable" word 'muttrc-variables-alist))))
+  (muttrc-find-help 'muttrc-search-variable-help-forward variable))
+
+(defun muttrc-bury-manual-buffer ()
+  (let ((buf (get-buffer muttrc-manual-buffer-name)))
+    (if buf (bury-buffer buf))))
+
+;;; ------------------------------------------------------------
+;;; Argument handlers
+;;; ------------------------------------------------------------
+
+(defun muttrc-call-arg-handler (key default &optional prompt)
+  "Call the function that properly prompts for an argument type."
+  (let ((handler-args (assoc key muttrc-arg-handler-alist)))
+    (or handler-args
+	(error "%s: unknown argument type." (symbol-name key)))
+    (let ((cmd (nth 0 (cdr handler-args)))
+	  (default-prompt (nth 1 (cdr handler-args)))
+	  (args (cdr (cddr handler-args))))
+      (apply cmd (or prompt default-prompt) default args))))
+
+(defun muttrc-get-boolean (prompt &optional default)
+  "Prompt for a boolean."
+  (y-or-n-p (format "%s? " prompt)))
+
+(defun muttrc-get-number (prompt default)
+  "Prompt for a string and return DEFAULT if the string is empty"
+  (or (read-from-minibuffer (muttrc-prompt-string prompt default))
+      default))
+
+(defun muttrc-get-string (prompt default)
+  "Prompt for a string and return DEFAULT if the string is empty"
+  (let ((s (read-from-minibuffer (muttrc-prompt-string prompt default))))
+    (if (> (length s) 0) s default)))
+
+(defun muttrc-get-word (prompt default)
+  "Prompt for a word and return DEFAULT if it is empty"
+  (let ((s (read-from-minibuffer (muttrc-prompt-string prompt default))))
+    (or (string-match "^\\w*$" s)
+	(error "%s: invalid entry, expecting a word" s))
+    (if (> (length s) 0) s default)))
+
+(defun muttrc-get-from-list (prompt default list &optional require-match)
+  "Prompt for a string from list and return DEFAULT if the string is empty"
+  (let ((s (completing-read (muttrc-prompt-string prompt default)
+			    (symbol-value list)
+			    nil require-match)))
+    (if (> (length s) 0) s default)))
+
+(defun muttrc-get-path (prompt default)
+  "Prompt for a path and return DEFAULT if the string is empty. The
+muttrc folder prefix is replaced by MUTTRC-FOLDER-ABBREV."
+  (let* ((folder (muttrc-get-value "folder"))
+	 (path (read-file-name (muttrc-prompt-string prompt default)
+			       folder folder)))
+    (let ((compacted-path
+	   (if (string-match (format "^%s/?\\(.*\\)$" (regexp-quote folder))
+			     path)
+	       (format "%s%s"
+		       (char-to-string muttrc-folder-abbrev)
+		       (match-string-no-properties 1 path))
+	     path)))
+      (if (not (string= compacted-path
+			(char-to-string muttrc-folder-abbrev)))
+	  compacted-path
+	default))))
+
+(defun muttrc-get-assignment (&optional prompt default
+					with-value-p)
+  (let ((varname (completing-read (muttrc-prompt-string prompt default)
+				  muttrc-variables-alist)))
+    (if (assoc varname muttrc-variables-alist)
+	(let* ((type (cadr (assoc varname muttrc-variables-alist)))
+	       (default (car-safe (muttrc-get-value-and-point varname)))
+	       (value (if with-value-p
+			(muttrc-call-arg-handler type default "Value"))))
+	  (if with-value-p
+	      (muttrc-assignement varname
+				  (and (eq type 'boolean)
+				       (not value)
+				       "no")
+				  value)
+	    varname))
+      default)))
+
+;;; ------------------------------------------------------------
+;;; Commands insertion
+;;; ------------------------------------------------------------
+
+(defun muttrc-get-command (&optional prompt default)
+  "Prompts the usr for a command to enter and asks for all the arguments."
+  (let* ((cmd (muttrc-get-from-list "Command" nil 'muttrc-command-alist t))
+	 (cmd-descriptor (cdr (assoc cmd muttrc-command-alist)))
+	 (arg-list-type (nth 0 cmd-descriptor))
+	 (repeat-p (nth 1 cmd-descriptor))
+	 (optional-p (nth 2 cmd-descriptor))
+	 (arg-list-value (list cmd)))
+    (save-window-excursion
+      (if (and muttrc-display-help)
+	  (save-excursion
+	    (muttrc-find-command-help cmd)))
+      (while arg-list-type
+	(let* ((arg-type (caar arg-list-type))
+	       (arg (apply 'muttrc-call-arg-handler
+			   (append (list arg-type nil)
+				   (cdar arg-list-type)))))
+	  (if arg
+	      (progn
+		(nconc arg-list-value
+		       (list (if (eq arg-type 'assignment)
+				 arg ; assignment are quoted by handler
+			       (muttrc-quote-string arg))))
+		(if (and repeat-p
+			 (null (cdr arg-list-type)))
+		    (setq optional-p t)
+		  (setq arg-list-type (cdr arg-list-type))))
+	    (if (and (null (cdr arg-list-type))
+		     optional-p)
+		(setq arg-list-type nil)
+	      (error "Argument required"))))))
+    (muttrc-bury-manual-buffer)
+    (mapconcat 'identity arg-list-value " ")))
+
+(defun muttrc-get-statement (&optional prompt default)
+  (let ((muttrc-command-alist muttrc-statement-alist))
+    (muttrc-get-command prompt default)))
+
+(defun muttrc-insert-command ()
+  "Insert a muttrc command on the current line."
+  (interactive)
+  (let ((cmd-line (muttrc-get-command)))
+    (beginning-of-line)
+    (or (eolp) (forward-line 1))
+    (insert cmd-line)
+    (newline)))
+
+;;; ------------------------------------------------------------
+;;; Setting variables
+;;; ------------------------------------------------------------
+
+(defun muttrc-update-current-line (varname type &optional value)
+  "Rewrites the current line by setting VARNAME to VALUE. If the
+statement is not \"set\", the variable is removed. In set statement,
+it is removed if the value is NIL and the variable is not a boolean.
+The function returns t is the variable is really assigned in the line."
+  (let* ((line (muttrc-split-next-set-line))
+	 (cmd (caar line))
+	 (kill-whole-line t)
+	 (args "")
+	 (set-p nil))
+    (beginning-of-line)
+    (kill-line)
+    (let ((l (cdr line)))
+      (while l
+	(let ((elt (car l)))
+	  (if (consp elt)
+	      (let ((this-var (nth 0 elt))
+		    (this-modifier (nth 1 elt))
+		    (this-value (nth 2 elt)))
+		(let ((assignement
+		       (if (string= this-var varname)
+			   (when (string= cmd "set")
+			     (setq set-p t)
+			     (cond ((eq type 'boolean)
+				    (muttrc-assignement varname
+							(if (not value) "no")
+							value))
+				   (value
+				    (muttrc-assignement varname nil value))
+				   (t (setq set-p nil))))
+			 (muttrc-assignement this-var
+					     this-modifier
+					     this-value))))
+		  (if assignement
+		      (setq args (concat args " " assignement)))))
+	    (setq args (concat args elt))))
+	(setq l (cdr l))))
+    (when (not (string= args ""))
+      (insert cmd)
+      (insert args)
+      (newline))
+    (backward-char 1)
+    set-p))
+
+(defun muttrc-update-variable (varname type value pos)
+  (catch 'done
+    (when pos
+      (goto-char pos)
+      (if (muttrc-update-current-line varname type value)
+	  (throw 'done t)))
+    (end-of-line)
+    (let ((cr-after-p (bolp))
+	  (cmd (if (or value (eq type 'boolean)) "set" "unset"))
+	  (modifier (if (and (not value) (eq type 'boolean)) "no")))
+      (or cr-after-p (newline))
+      (insert cmd " "
+	      (muttrc-assignement varname modifier value))
+      (if cr-after-p (newline))))
+  t)
+
+(defun muttrc-set-variable (&optional varname type value pos)
+  (interactive
+   (let* ((varname (muttrc-get-from-list "Variable" nil
+					 'muttrc-variables-alist t))
+	  (type (cadr (assoc varname muttrc-variables-alist)))
+	  (default (muttrc-get-value-and-point varname)))
+     (list varname type
+	   (save-window-excursion
+	     (if muttrc-display-help
+		 (save-excursion
+		   (muttrc-find-variable-help varname)))
+	     (muttrc-call-arg-handler type (car default)))
+	   (cdr default))))
+  (muttrc-bury-manual-buffer)
+  (muttrc-update-variable varname type value pos))
+
+(defun muttrc-unset-variable (&optional varname type pos)
+  (interactive
+   (let* ((varname (muttrc-get-from-list "Variable" nil
+					 'muttrc-variables-alist t))
+	  (type (cadr (assoc varname muttrc-variables-alist)))
+	  (default (muttrc-get-value-and-point varname)))
+     (list varname type (cdr default))))
+  (muttrc-update-variable varname type nil pos))
+
+(defun muttrc-find-variable-in-buffer (&optional varname)
+  (interactive
+   (list (muttrc-get-from-list "Variable" nil
+			       'muttrc-variables-alist t)))
+  (let* ((var-info (muttrc-get-value-and-point varname))
+	 (value (car var-info))
+	 (pos (cdr-safe var-info)))
+    (if pos
+	(goto-char pos)
+      (progn
+	(message "%s: variable not set (default: %s)" varname value)))))
+
+;;; ------------------------------------------------------------
+;;; Almost the end
+;;; ------------------------------------------------------------
+
+(provide 'muttrc-mode)
+
+;;; muttrc-mode.el ends here
diff --git a/elisp/emacs-goodies-el/nuke-trailing-whitespace.el b/elisp/emacs-goodies-el/nuke-trailing-whitespace.el
new file mode 100755
index 0000000..fd33ab2
--- /dev/null
+++ b/elisp/emacs-goodies-el/nuke-trailing-whitespace.el
@@ -0,0 +1,163 @@
+;;; whitespace.el --- strip trailing whitespace from buffers
+
+;; Copyright (C) 1995, 1996, 1997, 2000 Noah S. Friedman
+
+;; Author: Noah Friedman 
+;; Maintainer: friedman@splode.com
+;; Keywords: extensions
+;; Status: Works in Emacs 19 and XEmacs.
+
+;; $Id: nuke-trailing-whitespace.el,v 1.2 2009-09-04 02:24:05 psg Exp $
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, you can either send email to this
+;; program's maintainer or write to: The Free Software Foundation,
+;; Inc.; 51 Franklin Street, Fifth Floor; Boston, MA 02110-1301, USA.
+
+;;; Commentary:
+
+;; You may wish to do the following in your .emacs:
+;;
+;;     (autoload 'nuke-trailing-whitespace "whitespace" nil t)
+;;     (add-hook 'mail-send-hook 'nuke-trailing-whitespace)
+;;     (add-hook 'write-file-hooks 'nuke-trailing-whitespace)
+
+;;; Code:
+
+(defvar nuke-trailing-whitespace-p 'whitespace-check-mode
+  "*Specify when stripping whitespace should be done.
+This variable affects how the function `nuke-trailing-whitespace' behaves.
+If `t', unreservedly strip trailing whitespace, including excess newlines.
+If `nil', do nothing.
+If a symbol \(not bound to a function\), query for each instance.
+
+If a function or name of a function, call it to decide what to do.
+This function is called once and should return `t', `nil', or the symbol
+`query' to decide what to do.
+
+This variable is made buffer-local when set in any fashion.")
+(make-variable-buffer-local 'nuke-trailing-whitespace-p)
+
+;; The regexp "\\s-+$" is too general, since form feeds (\n), carriage
+;; returns (\r), and form feeds/page breaks (C-l) count as whitespace in
+;; some syntaxes even though they serve a functional purpose in the file.
+(defconst whitespace-regexp "[ \t]+$"
+  "Regular expression which matches trailing whitespace.")
+
+;; Match two or more trailing newlines at the end of the buffer; all but
+;; the first newline will be deleted.
+(defconst whitespace-eob-newline-regexp "\n\n+\\'"
+  "Regular expression which matches newlines at the end of the buffer.")
+
+(defvar nuke-trailing-whitespace-always-major-modes
+  '(ada-mode
+    c++-mode
+    c-mode
+    change-log-mode
+    cperl-mode
+    emacs-lisp-mode
+    fortran-mode
+    latex-mode
+    lisp-interaction-mode
+    lisp-mode
+    makefile-mode
+    nroff-mode
+    perl-mode
+    plain-tex-mode
+    prolog-mode
+    scheme-mode
+    sgml-mode
+    tcl-mode
+    slitex-mode
+    sml-mode
+    texinfo-mode)
+  "*Major modes for which `whitespace-check-mode' will return `t'.
+These are major modes for which `nuke-trailing-whitespace' should
+strip all trailing whitespace and excess newlines at the end of the buffer
+without asking.")
+
+(defvar nuke-trailing-whitespace-never-major-modes
+  '(mail-mode
+    rmail-mode
+    vm-mode
+    vm-summary-mode)
+  "*Major modes for which `whitespace-check-mode' will return `nil'.
+These are major modes for which `nuke-trailing-whitespace' should
+never strip trailing whitespace automatically.")
+
+
+;;;###autoload
+(defun nuke-trailing-whitespace ()
+  "Nuke all trailing whitespace in the buffer.
+Whitespace in this case is just spaces or tabs.
+This is a useful function to put on write-file-hooks.
+
+Unless called interactively, this function uses
+`nuke-trailing-whitespace-p' to determine how to behave.
+However, even if this variable is `t', this function will query for
+replacement if the buffer is read-only."
+  (interactive)
+  (cond ((interactive-p)
+         (call-interactively 'whitespace-do-nuke-whitespace))
+        (t
+         (let ((flag nuke-trailing-whitespace-p))
+           (and nuke-trailing-whitespace-p
+                (symbolp nuke-trailing-whitespace-p)
+                (fboundp nuke-trailing-whitespace-p)
+                (setq flag (funcall nuke-trailing-whitespace-p)))
+
+           (and flag
+                (whitespace-do-nuke-whitespace flag)))))
+  ;; always return nil, in case this is on write-file-hooks.
+  nil)
+
+(defun whitespace-do-nuke-whitespace (&optional flag)
+  (interactive)
+  (let ((buffer-orig-read-only buffer-read-only)
+        (buffer-read-only nil))
+    (save-excursion
+      (save-restriction
+        (save-match-data
+          (widen)
+          (goto-char (point-min))
+          (cond
+           ((or (and (eq flag t)
+                     (not buffer-orig-read-only))
+                (interactive-p))
+            (while (re-search-forward whitespace-regexp (point-max) t)
+              (delete-region (match-beginning 0) (match-end 0)))
+            (goto-char (point-min))
+            (and (re-search-forward whitespace-eob-newline-regexp nil t)
+                 (delete-region (1+ (match-beginning 0)) (match-end 0))))
+           (t
+            (query-replace-regexp whitespace-regexp "")
+            (goto-char (point-min))
+            (and (re-search-forward whitespace-eob-newline-regexp nil t)
+                 (save-match-data
+                   (y-or-n-p
+                    "Delete excess trailing newlines at end of buffer? "))
+                 (delete-region (1+ (match-beginning 0)) (match-end 0))))))))))
+
+(defun whitespace-check-mode (&optional mode)
+  (or mode (setq mode major-mode))
+  (cond ((memq mode nuke-trailing-whitespace-always-major-modes) t)
+        ((memq mode nuke-trailing-whitespace-never-major-modes) nil)
+        ;; Only query for visible buffers; invisible buffers are probably
+        ;; managed by programs (e.g. w3 history list) and a query for them
+        ;; is confusing.
+        ((get-buffer-window (current-buffer) t) 'query)
+        (t nil)))
+
+(provide 'whitespace)
+
+;;; whitespace.el ends here.
diff --git a/elisp/emacs-goodies-el/obfusurl.el b/elisp/emacs-goodies-el/obfusurl.el
new file mode 100755
index 0000000..f63b31c
--- /dev/null
+++ b/elisp/emacs-goodies-el/obfusurl.el
@@ -0,0 +1,114 @@
+;;; obfusurl.el --- Obfuscate URLs so they aren't spoilers
+;; Copyright 2001-2008 by Dave Pearson 
+;; $Revision: 1.3 $
+
+;; obfusurl.el is free software distributed under the terms of the GNU
+;; General Public Licence, version 2 or (at your option) any later version.
+;; For details see the file COPYING.
+
+;;; Commentary:
+;;
+;; obfusurl.el provides `obfuscate-url', a command that will obfuscate an
+;; URL under the cursor. This might be useful if you are writing out an URL
+;; for someone but the URL itself might spoil the surprise.
+;;
+;; For example, this:
+;;
+;; 
+;;
+;; is turned into this:
+;;
+;; 
+;;
+;; The latest obfusurl.el is always available from:
+;;
+;;   
+;;   
+
+;;; THANKS:
+;;
+;; Andy Sawyer  for initially pointing out that URLs with
+;; percent escapes already in them would get broken.
+;;
+;; Kevin Rodgers  for suggesting a method of fixing the
+;; above.
+;;
+;; Toby Speight  for pointing out that I needed to
+;; cater for reserved characters.
+
+;;; INSTALLATION:
+;;
+;; o Drop obfusurl.el somwehere into your `load-path'. Try your site-lisp
+;;   directory for example (you might also want to byte-compile the file).
+;;
+;; o Add the following autoload statement to your ~/.emacs file:
+;;
+;;   (autoload 'obfuscate-url "obfusurl" "Obfuscate URL under point" t)
+
+;;; Code:
+
+;; Things we need:
+
+(eval-when-compile
+  (require 'cl))
+(require 'thingatpt)
+
+;; Constants.
+
+(defconst obfuscate-url-reserved-chars '(?\; ?/ ?? ?: ?@ ?& ?= ?+ ?$ ?,)
+  "Characters reserved by RFC 2396.")
+
+;; Main code.
+
+(defun obfuscate-url-hexify-string (string)
+  "Return STRING as percent-escaped hex values.
+
+Existing percent-escapes and reserved characters (as defined in RFC 2396) in
+the text are preserved."
+  (flet ((hexify-string (string)
+           (with-output-to-string
+             (mapc (lambda (c)
+                     (princ (format
+                             (if (member c obfuscate-url-reserved-chars)
+                                 "%c"
+                               "%%%02x")
+                             c))) string))))
+    (let ((case-fold-search t))
+      (with-output-to-string
+        (loop for i = 0 then (match-end 0)
+              while (string-match "%[0-9a-f][0-9a-f]" string i)
+              do (princ
+                  (concat (hexify-string (substring string i (match-beginning 0)))
+                          (match-string 0 string)))
+              finally (princ (hexify-string (substring string i))))))))
+
+(defun obfuscate-url-hexify-url (url)
+  "Return URL as a percent-escaped URL."
+  (let ((trailing-slash (string-match "/$" url))
+        (split          (split-string url "/")))
+    (with-output-to-string
+      (princ (format "%s//%s" (nth 0 split) (nth 2 split)))
+      (loop for part in (nthcdr 3 split)
+            unless (string= part "")    ; Because of XEmacs' `split-string'.
+            do (princ (concat "/" (obfuscate-url-hexify-string part)))
+            finally (when trailing-slash (princ "/"))))))
+
+;;;###autoload
+(defun obfuscate-url ()
+  "Obfuscate an URL under `point'.
+
+This might be useful if you're writing out an URL for someone but the URL
+itself is a spoiler. The URL will still work but it won't be readable (by
+most mortals anyway)."
+  (interactive "*")
+  (let ((url (thing-at-point 'url)))
+    (if url
+        (let ((bounds (bounds-of-thing-at-point 'url)))
+          (setf (point) (car bounds))
+          (delete-region (car bounds) (cdr bounds))
+          (insert (obfuscate-url-hexify-url url)))
+      (error "I can't see an URL here"))))
+
+(provide 'obfusurl)
+
+;;; obfusurl.el ends here
diff --git a/elisp/emacs-goodies-el/pack-windows.el b/elisp/emacs-goodies-el/pack-windows.el
new file mode 100755
index 0000000..4351944
--- /dev/null
+++ b/elisp/emacs-goodies-el/pack-windows.el
@@ -0,0 +1,224 @@
+;;; pack-windows.el --- Resize all windows to display as much info as possible.
+
+;; Copyright (C) 2000 Michel Schinz
+
+;; 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:
+;;
+;; Resize all windows vertically to display as much information as possible
+;; with the command `M-x pack-windows'.
+;;
+;; Only windows that are on the left edge of the frame are taken into
+;; account. The vertical space available in the frame is first divided
+;; among all these windows. Then any window requireing less lines than it
+;; got to display its whole buffer is shrinked, and the freed space is
+;; divided equally among all the other windows.
+;;
+;; If some vertical space remains afterwards, it is given in totality to
+;; the currently selected window.
+;;
+;; Do not shrink any window to less than `window-min-height'.
+;;
+;; Shrink windows iteratively, performing at most `pack-windows-max-iteration'
+;; iterations. The number of iterations really performed will be
+;; displayed in the echo area if `pack-windows-verbose' is non-nil.
+
+;;; History:
+;;
+;; $Id: pack-windows.el,v 1.1 2003-11-17 19:44:28 psg Exp $
+;;
+;; 2003-11-17
+;; Incorporated modifications by Peter S Galbraith :
+;; - standardised prefix to pack-windows- (instead of pw-),
+;; - added a defgroup,
+;; - added an autoload tag for the main function,
+;; - added a Commentary field,
+;; - made some changes suggested by M-x checkdoc.
+
+;;; Code:
+
+(require 'cl)
+
+(defgroup pack-windows nil
+  "Resize all windows to display as much info as possible."
+  :group 'convenience)
+
+(defcustom pack-windows-max-iteration 10
+  "`pack-windows' performs at most this number of iterations to pack windows."
+  :type 'integer
+  :group 'pack-windows)
+
+(defcustom pack-windows-verbose nil
+  "If true, `pack-windows' will say how much iterations it performed."
+  :type 'boolean
+  :group 'pack-windows)
+
+;; Information about windows is encoded in pairs: the CAR contains the
+;; window, the CDR its ideal or final height.
+(defsubst make-win-pair (window ideal-height) (cons window ideal-height))
+(defsubst emacs-window (win-pair) (car win-pair))
+(defsubst ideal-height (win-pair) (cdr win-pair))
+(defsubst set-ideal-height (win-pair height) (setcdr win-pair height))
+
+(defun pack-windows-frame-windows (frame pred)
+  "Return a list of all windows in FRAME satisfying PRED, minibuffer excepted."
+  (loop for win being the windows of frame
+	if (and (not (window-minibuffer-p win))
+		(funcall pred win))
+	collect win))
+
+;; This is mostly like `window-buffer-height' from windows.el, but
+;; with the MAX parameter, and one bug less.
+(defun pack-windows-window-buffer-height (window max)
+  "Return height (in screen lines) WINDOW's buffer, bounded by MAX."
+  (save-excursion
+    (set-buffer (window-buffer window))
+    (goto-char (point-min))
+    (1+ (nth 2 (compute-motion (point-min)
+			       '(0 . 0)
+			       (point-max)
+			       (cons 0 (1- max))
+			       (1- (window-width window))
+			       nil
+			       window)))))
+
+(defun pack-windows-compute-heights (windows avail-height)
+  "Compute new heights of WINDOWS so that they fit in AVAIL-HEIGHT."
+  (unless (null windows)
+    (let* ((avg-height (/ avail-height (length windows)))
+	   (fit-in-avg-p #'(lambda (win)
+			     (<= (ideal-height win) avg-height)))
+	   (fitting-windows (remove-if-not fit-in-avg-p windows)))
+      (if (null fitting-windows)
+	  ;; No fitting windows, we divide available height among all.
+	  (let ((err (% avail-height (length windows))))
+	    (loop for win in windows
+		  for index from 1 do
+		  (set-ideal-height
+		   win
+		   (if (<= index err) (1+ avg-height) avg-height))))
+	;; Some windows fit, we leave them as-is and restart the
+	;; process with the remaining windows.
+	(pack-windows-compute-heights (remove-if fit-in-avg-p windows)
+			    (- avail-height
+			       (reduce #'+ fitting-windows
+				       :key #'ideal-height)))))))
+
+(defsubst pack-windows-shrink-value (win-pair)
+  "Return the difference between the current and ideal size of WIN-PAIR."
+  (- (window-height (emacs-window win-pair))
+     (ideal-height win-pair)))
+
+(defsubst pack-windows-max-shrink-value (win-pairs)
+  "Return the element of WIN-PAIRS with maximum shrink value.
+See `pack-windows-shrink-value'."
+  (reduce #'(lambda (best new)
+	      (if (> (pack-windows-shrink-value new)
+                     (pack-windows-shrink-value best))
+		  new
+		best))
+	  win-pairs))
+
+;;;###autoload
+(defun pack-windows ()
+  "Resize all windows vertically to display as much information as possible.
+
+Only windows that are on the left edge of the frame are taken into
+account. The vertical space available in the frame is first divided
+among all these windows. Then any window requireing less lines than it
+got to display its whole buffer is shrinked, and the freed space is
+divided equally among all the other windows.
+
+If some vertical space remains afterwards, it is given in totality to
+the currently selected window.
+
+Do not shrink any window to less than `window-min-height'.
+
+Shrink windows iteratively, performing at most `pack-windows-max-iteration'
+iterations. The number of iterations really performed will be
+displayed in the echo area if `pack-windows-verbose' is non-nil."
+  (interactive)
+  (let* ((emacs-windows (pack-windows-frame-windows (selected-frame)
+					  #'(lambda (w)
+					      (zerop (car (window-edges w))))))
+	 (avail-height (reduce #'+ emacs-windows :key #'window-height))
+	 (windows (mapcar #'(lambda (win)
+			      (make-win-pair win
+					     (max window-min-height
+						  (1+ (pack-windows-window-buffer-height
+						       win
+						       (1- avail-height))))))
+			  emacs-windows))
+	 (desired-height (reduce #'+ windows :key #'ideal-height)))
+
+    ;; If all windows fit, we give any "superfluous" height to the
+    ;; first one in the list (the selected one, provided it's aligned
+    ;; on the left margin) and proceed. Otherwise, we distribute the
+    ;; height available among all windows.
+    (if (<= desired-height avail-height)
+	(let ((first-win (car windows)))
+	  (set-ideal-height first-win (+ (ideal-height first-win)
+					 (- avail-height desired-height))))
+      (pack-windows-compute-heights windows avail-height))
+
+    ;; At this point, the sum of the ideal heights of all windows is
+    ;; guaranteed to be equal to the available height:
+    ;(assert (= (reduce #'+ windows :key #'ideal-height)
+    ;	       avail-height))
+
+    ;; Resize windows. We have to iterate since resizing one
+    ;; window also resizes its neighbours.
+    ;; We try our best not to delete any window in the process, but if
+    ;; that happens, we restore the current window configuration and
+    ;; display a message.
+    (let ((win-config (current-window-configuration)))
+      (condition-case nil
+	  (save-selected-window
+	    (when (> (length windows) 1)
+	      ;; At each iteration we chose the window that has to be
+	      ;; shrinked the most, in an attempt to avoid killing
+	      ;; neighbouring windows.
+	      (loop for iter from 1 to pack-windows-max-iteration
+		    finally (when pack-windows-verbose
+			      (message "pack-windows: %d iterations" iter))
+		    until (loop for wins = windows then (remove win-pair wins)
+				while wins
+				for win-pair = (pack-windows-max-shrink-value wins)
+				for shrink = (pack-windows-shrink-value win-pair)
+				sum shrink into total-shrink
+				finally return (zerop total-shrink) do
+
+				(select-window (emacs-window win-pair))
+				(shrink-window
+                                 (pack-windows-shrink-value win-pair))))))
+	  (error
+	   (message "Cannot pack windows without deleting one, sorry")
+	   (set-window-configuration win-config))))
+
+    ;; Display as much information as possible in all windows.
+    (save-selected-window
+      (dolist (win windows)
+	(let ((emacs-win (emacs-window win)))
+	  (select-window emacs-win)
+	  (when (= (window-end emacs-win) (point-max))
+	    (save-excursion
+	      (goto-char (point-max))
+	      (recenter -1))))))))
+
+(provide 'pack-windows)
+
+;;; pack-windows.el ends here
diff --git a/elisp/emacs-goodies-el/perldoc.el b/elisp/emacs-goodies-el/perldoc.el
new file mode 100755
index 0000000..194a4ee
--- /dev/null
+++ b/elisp/emacs-goodies-el/perldoc.el
@@ -0,0 +1,296 @@
+;;; perldoc.el --- Show help for Perl functions, builtins, and modules.
+
+;;
+;; Copyright (C) 2000-2002 Steve Kemp 
+;; Copyright (C) 2003, 2005 Peter S Galbraith 
+;; Copyright (C) 2008-2009 Ben Voui 
+
+;; 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; either version 2, or (at your option)
+;; any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with 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 package allows the user to view the Perl help for the word(s) at
+;;  the point.
+;;
+;;  When this is loaded it adds a hook both `cperl-mode', and `perl-mode',
+;; allowing the perldoc help to be shown for the thing under the point, by
+;; pressing F1.
+;;
+;;  The code handles functions, builtins, and third party modules.
+
+;;; Version History
+;;
+;;  1.0 - Initial Release.
+;;  1.1 - Show error message when no help is found.
+;;      - Fix name.
+;;      - Include GPL + URL.
+;;  1.2 Alan Shutko 
+;;        perldoc runs a pager, so run a benign one.  See Debian bug
+;;        http://bugs.debian.org/144963
+;;  1.3 Peter S Galbraith 
+;;      - Checkdoc clean.
+;;      - Generate list of functions on the fly instead of using a
+;;        hardwired list.
+;;      - ToDo? Allow completion on module names, harvested from all .pod
+;;              file under directories in @INC.
+;;  1.4 Peter S Galbraith 
+;;      - Handle case where Debian perldoc package is not installed.
+;;        Thanks to Kevin Ryde  for the full bug report.
+;;
+;;  1.5 Peter S Galbraith 
+;;      - Apply patch from Kevin Ryde (Closes: #314869)
+;;
+;;  1.6 Ben Voui 
+;;      - Complete modules names as well.
+;;      - Allow using several uniquely-named perldoc buffers, thanks to the
+;;        perldoc-unique-buffer custom setting.
+;;
+;;  1.7 Ben Voui 
+;;      - A non-nil interactive argument forces the cache to be updated.
+;;
+;;  1.8 Ben Voui 
+;;      - Avoid saving incomplete perldoc-modules-alist
+;;        perldoc-functions-alist (Closes: #575455)
+;;
+;;  1.9 Ben Voui 
+;;      - Don't depend on the existence of default-directory.
+;;        Thanks to Kevin Ryde  for the patch.
+;;        (Closes: #574650)
+;;
+;;  2.0 Ben Voui 
+;;      - Complete for Perl core documentation.
+;;        Thanks to Florian Ragwitz  for the bug report.
+;;        (Closes: #589785)
+
+
+;;  Comments / suggests / feedback welcomed to
+;;  skx@tardis.ed.ac.uk and intrigeri@boum.org
+
+;;  intrigeri's "upstream" lives in a Git repository:
+;;  git://gaffer.ptitcanardnoir.org/perldoc-el.git
+
+;;; Code:
+
+(require 'thingatpt)
+
+(autoload 'Man-fontify-manpage "man")
+
+(defgroup perldoc nil
+  "Show help for Perl functions, builtins, and modules."
+  :group  'help)
+
+(defcustom perldoc-define-F1 nil
+  "If non-nil, bind [F1] to `perl-doc-at-point' in perl modes.
+It installs `perldoc-perl-hook' in Perl mode hooks."
+  :type 'boolean
+  :group 'perldoc
+  :require 'perldoc
+  :set (lambda (symbol value)
+         (set-default symbol value)
+         (cond
+          (value
+           (add-hook 'cperl-mode-hook 'perldoc-perl-hook)
+           (add-hook 'perl-mode-hook 'perldoc-perl-hook))
+          (t
+           (remove-hook 'cperl-mode-hook 'perldoc-perl-hook)
+           (remove-hook 'perl-mode-hook 'perldoc-perl-hook)))))
+
+(defcustom perldoc-unique-buffer t
+  "If nil, use uniquely-named buffers, such as *Perldoc Getopt::Long*.
+Else, use a single *Perldoc* buffer."
+  :type 'boolean
+  :group 'perldoc
+  )
+
+(defvar perldoc-functions-alist nil
+  "Alist holding the list of perl functions.")
+
+(defun perldoc-functions-alist (&optional re-cache)
+  "Return the alist of perl functions constructed from perlfunc.pod.
+A non-nil argument forces caches to be updated."
+  (if (and perldoc-functions-alist (not re-cache))
+      perldoc-functions-alist
+    (setq perldoc-functions-alist
+	  (let ((tmp-buffer (get-buffer-create " *perldoc*"))
+		(case-fold-search nil)
+		(tmp-functions-alist nil))
+	    (set-buffer tmp-buffer)
+	    (erase-buffer)
+	    (let ((default-directory "/"))
+	      (shell-command "perldoc -u perlfunc" t))
+	    (goto-char (point-min))
+	    (cond
+	     ((search-forward "Alphabetical Listing of Perl Functions" nil t)
+	      (while (re-search-forward
+		      "^=item \\(\\([a-z][^ //\n]*\\)\\|\\(I<\\(.*\\)> \\)\\)" nil t)
+		(let ((entry (list (or (match-string 2)(match-string 4)))))
+		  (when (not (member entry tmp-functions-alist))
+		    (push entry tmp-functions-alist))))
+	      ;; no output means the perldoc program doesn't exist or is only the
+	      ;; debian perl package dummy script
+	      (unless tmp-functions-alist
+		(error "`perldoc' program not available"))
+	      tmp-functions-alist)
+	     ((re-search-forward "You need to install.*" nil t)
+	      (error (format "%s" (match-string 0))))
+	     (t
+	      (error "`perldoc' program not available")))))))
+
+(defvar perldoc-modules-alist nil
+  "Alist holding the list of perl modules.")
+
+(defun perldoc-modules-alist (&optional re-cache)
+  "Return the alist of perl modules found in @INC.
+An non-nil argument forces caches to be updated."
+  (if (and perldoc-modules-alist (not re-cache))
+      perldoc-modules-alist
+    (setq perldoc-modules-alist
+	  (let ((tmp-buffer (get-buffer-create " *perldoc*"))
+		(case-fold-search nil)
+		(perldoc-inc nil)
+		(tmp-modules-alist nil))
+	    (set-buffer tmp-buffer)
+	    (erase-buffer)
+	    (let ((default-directory "/"))
+	      (shell-command "perl -e 'print \"@INC\"'" t))
+	    (goto-char (point-min))
+	    (while (re-search-forward "\\(/[^ ]*\\)" nil t)
+	      (let ((libdir (match-string 1)))
+		(when (not (member libdir perldoc-inc))
+		  (push libdir perldoc-inc))))
+	    (dolist (dir perldoc-inc)
+	      (let (modules (list))
+		(when (file-readable-p dir)
+		  (erase-buffer)
+		  (let ((default-directory "/"))
+		    (shell-command (concat "find -L " dir " -name '[A-Z]*.pm' -o -name '*.pod'") t))
+		  (goto-char (point-min))
+		  (while (re-search-forward (concat "^" (regexp-quote dir) "/\\(.*\\).\\(pm\\|pod\\)$") nil t)
+		    (let ((entry (list (replace-regexp-in-string "/" "::"
+								 (replace-regexp-in-string "^pod/" "" (match-string 1))))))
+		      (when (not (member entry tmp-modules-alist))
+			(push entry tmp-modules-alist)))))))
+	    tmp-modules-alist))))
+
+(defvar perldoc-all-completions-alist nil
+  "Alist holding the list of perl functions and modules.")
+
+(defun perldoc-all-completions-alist (&optional re-cache)
+  "Return the alist of perl functions and modules.
+A non-nil argument forces the caches to be updated."
+  (if (and perldoc-all-completions-alist (not re-cache))
+      perldoc-all-completions-alist
+    (message "Building completion list of all perldoc topics...")
+    (setq perldoc-all-completions-alist
+	  (append (perldoc-functions-alist t)
+		  (perldoc-modules-alist t)))))
+
+;;;###autoload
+(defun perldoc (&optional string re-cache)
+  "Run perldoc on the given STRING.
+If the string is a recognised function then we can call `perldoc-function',
+otherwise we call `perldoc-module'.
+A non-nil interactive argument forces the caches to be updated."
+  (interactive (list nil current-prefix-arg))
+  (if (or re-cache
+	  (not perldoc-all-completions-alist))
+    (perldoc-all-completions-alist t))
+  (unless (stringp string)
+    (setq string (completing-read "Perl function or module: "
+				  (perldoc-all-completions-alist) nil nil)))
+  (cond
+   ((assoc string perldoc-functions-alist)
+    (perldoc-function string))
+   ((stringp string)
+    (perldoc-module string))
+   (t
+    (message "Nothing to find."))))
+
+(defun perldoc-get-buffer-name (target)
+  "Return the buffer name used to display documentation about TARGET."
+  (or
+   (and (not perldoc-unique-buffer)
+	(stringp target)
+	(concat"*Perldoc " target "*"))
+   "*Perldoc*"))
+
+(defun perldoc-start-process (&rest args)
+  "Call perldoc with ARGS.
+Sets up process sentinals and needed environment to call perldoc."
+  (let ((buffer-name (perldoc-get-buffer-name (car (reverse args)))))
+    (set-buffer (get-buffer-create buffer-name))
+    (kill-all-local-variables)
+    (erase-buffer)
+    (text-mode)
+    (message "Loading documentation ..")
+    (set-process-sentinel
+     (let ((default-directory "/"))
+       (apply 'start-process args))
+     'perldoc-sentinel)))
+
+(defun perldoc-function (function)
+ "Show the help text for the given Perl FUNCTION / builtin."
+ (interactive (list (completing-read "Perl function: "
+                                     (perldoc-functions-alist) nil t)))
+ (perldoc-start-process "perldol" (perldoc-get-buffer-name function) "perldoc" "-T" "-f" function))
+
+(defun perldoc-module (module)
+ "Show the help text for the given Perl MODULE."
+ (interactive (list (completing-read "Perl module: "
+                                     (perldoc-modules-alist) nil t)))
+   (perldoc-start-process "perldol" (perldoc-get-buffer-name module) "perldoc" "-T" module))
+
+(defun perldoc-process-filter (proc string)
+  "Process the results from the catdoc process PROC, inserting STRING."
+  (message "buffer: %s" (process-buffer proc))
+  (set-buffer (process-buffer proc))
+  (insert string))
+
+(defun perldoc-sentinel (proc msg)
+  "Perldoc sentinel for process PROC and MSG describing the change.
+When the catdoc process has finished, switch to its output buffer."
+  (let ((buffer (process-buffer proc)))
+    (when (eq (process-status proc) 'exit)
+      (set-buffer buffer)
+      (goto-char (point-min))
+      (cond
+       ((and (< (count-lines (point-min) (point-max)) 2)
+	     (re-search-forward "No documentation found for .*" nil t))
+	(message (match-string 0))
+	(kill-buffer (get-buffer buffer)))
+       (t
+	(pop-to-buffer buffer)
+	(goto-char (point-min))
+	(let ((Man-args "perldoc"))
+	  (Man-fontify-manpage)))))))
+
+;;;###autoload
+(defun perldoc-at-point ()
+  "Call `perldoc' for string at point."
+  (interactive)
+  (perldoc (or (thing-at-point 'word)
+               (thing-at-point 'filename))))
+
+;;;###autoload
+(defun perldoc-perl-hook ()
+  "A hook which binds F1 to `perldoc-at-point'."
+  (local-set-key [f1] 'perldoc-at-point))
+
+(provide 'perldoc)
+;;; perldoc.el ends here
diff --git a/elisp/emacs-goodies-el/pod-mode.el b/elisp/emacs-goodies-el/pod-mode.el
new file mode 100755
index 0000000..1617a32
--- /dev/null
+++ b/elisp/emacs-goodies-el/pod-mode.el
@@ -0,0 +1,706 @@
+;;; pod-mode.el --- Major mode for editing .pod-files
+
+;;; POD is the Plain Old Documentation format of Perl.
+
+;;; Copyright 2003-2010 Steffen Schwigon
+
+;;; Author: Steffen Schwigon 
+;;;
+;;; Keywords: perl pod
+;;; X-URL: http://search.cpan.org/~schwigon/pod-mode/
+
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2, or (at your option)
+;;; any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
+;;; MA 02110-1301, USA.
+
+;;; This code is supposed to work on all platforms on both GNU Emacs
+;;; and XEmacs at least as of version 21.2.1 and 21.4,
+;;; respectively. Please speak up if it doesn't on your platform or
+;;; recent-ish version of an Emacs of your choice
+
+;;; Commentary:
+
+;;; This mode is built with help of the
+;;; "Emacs language mode creation tutorial" at
+;;;
+;;;   http://two-wugs.net/emacs/mode-tutorial.html
+;;;
+;;; which disapeared from the net and is now hosted at
+;;;
+;;;   http://renormalist.net/Renormalist/EmacsLanguageModeCreationTutorial
+;;;
+
+;;; Usage:
+
+;;; Put this file into your load-path and the following into your ~/.emacs:
+;;;
+;;;    (require 'pod-mode)
+;;;
+;;;
+;;; To associate pod-mode with .pod files add the following to your ~/.emacs
+;;;
+;;;    (add-to-list 'auto-mode-alist '("\\.pod$" . pod-mode))
+;;;
+;;;
+;;; To automatically turn on font-lock-mode add the following to your ~/.emacs
+;;;
+;;;    (add-hook 'pod-mode-hook 'font-lock-mode)
+;;;
+;;;
+;;; In addition to the standard POD commands, custom commands as
+;;; defined by a Pod::Weaver configuration are supported. However, for
+;;; those to work, eproject.el as available at
+;;; http://github.com/jrockway/eproject is required.
+;;;
+;;; Make sure to require eproject.el or create an autoload for
+;;; eproject-maybe-turn-on if you expect custom commands to work.
+;;;
+;;;
+;;; When automatically inserting hyperlink formatting codes to modules
+;;; or sections within modules, autocompletion for module names will
+;;; be provided if perldoc.el, as available at
+;;; git://gaffer.ptitcanardnoir.org/perldoc-el.git, is present.
+;;;
+
+;;; Code:
+
+(require 'cl)
+
+(defgroup pod-mode nil
+  "Mode for editing POD files"
+  :group 'faces)
+
+(defgroup pod-mode-faces nil
+  "Faces for highlighting POD constructs"
+  :prefix "pod-mode-"
+  :group 'pod-mode)
+
+(defface pod-mode-command-face
+  '((((class grayscale) (background light)) (:foreground "LightGray" :weight bold))
+    (((class grayscale) (background dark)) (:foreground "DimGray" :weight bold))
+    (((class color) (min-colors 88) (background light)) (:foreground "Purple"))
+    (((class color) (min-colors 88) (background dark)) (:foreground "Cyan1"))
+    (((class color) (min-colors 16) (background light)) (:foreground "Purple"))
+    (((class color) (min-colors 16) (background dark)) (:foreground "Cyan"))
+    (((class color) (min-colors 8)) (:foreground "cyan" :weight bold))
+    (t (:weight bold)))
+  "Face used to highlight POD commands"
+  :group 'pod-mode-faces)
+
+(defface pod-mode-head-face
+  '((t (:inherit pod-mode-command-face)))
+  "Face used to highlight =head commands"
+  :group 'pod-mode-faces)
+
+(defface pod-mode-command-text-face
+  '((((class grayscale) (background light))
+     (:foreground "DimGray" :weight bold :slant italic))
+    (((class grayscale) (background dark))
+     (:foreground "LightGray" :weight bold :slant italic))
+    (((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"))
+    (((class color) (min-colors 8) (background dark))
+     )
+    (t (:weight bold :slant italic)))
+  "Face used to highlight text after POD commands"
+  :group 'pod-mode-faces)
+
+(defface pod-mode-verbatim-face
+  '((((class grayscale) (background light)) (:foreground "Gray90" :weight bold))
+    (((class grayscale) (background dark)) (:foreground "DimGray" :weight bold))
+    (((class color) (min-colors 88) (background light)) (:foreground "ForestGreen"))
+    (((class color) (min-colors 88) (background dark)) (:foreground "PaleGreen"))
+    (((class color) (min-colors 16) (background light)) (:foreground "ForestGreen"))
+    (((class color) (min-colors 16) (background dark)) (:foreground "PaleGreen"))
+    (((class color) (min-colors 8)) (:foreground "green"))
+    (t (:weight bold :underline t)))
+  "Face used to highlight verbatim paragraphs in POD"
+  :group 'pod-mode-faces)
+
+(defface pod-mode-formatting-code-character-face
+  '((((class grayscale) (background light))
+     (:foreground "Gray90" :weight bold :slant italic))
+    (((class grayscale) (background dark))
+     (:foreground "DimGray" :weight bold :slant italic))
+    (((class color) (min-colors 88) (background light)) (:foreground "sienna"))
+    (((class color) (min-colors 88) (background dark)) (:foreground "LightGoldenrod"))
+    (((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod"))
+    (((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod"))
+    (((class color) (min-colors 8)) (:foreground "yellow" :weight light))
+    (t (:weight bold :slant italic)))
+  "Face used to highlight formatting codes in POD"
+  :group 'pod-mode-faces)
+
+(defface pod-mode-formatting-code-face
+  '((((class grayscale) (background light))
+     (:foreground "LightGray" :weight bold :underline t))
+    (((class grayscale) (background dark))
+     (:foreground "Gray50" :weight bold :underline t))
+    (((class color) (min-colors 88) (background light)) (:foreground "dark cyan"))
+    (((class color) (min-colors 88) (background dark)) (:foreground "Aquamarine"))
+    (((class color) (min-colors 16) (background light)) (:foreground "CadetBlue"))
+    (((class color) (min-colors 16) (background dark)) (:foreground "Aquamarine"))
+    (((class color) (min-colors 8)) (:foreground "magenta"))
+    (t (:weight bold :underline t)))
+  "Face used to highlight text within formatting codes in POD"
+  :group 'pod-mode-faces)
+
+(defface pod-mode-formatting-code-i-face
+  '((t (:inherit pod-mode-formatting-code-face :slant italic)))
+  "Face used to highlight I<> formatting codes in POD"
+  :group 'pod-mode-faces)
+
+(defface pod-mode-formatting-code-b-face
+  '((t (:inherit pod-mode-formatting-code-face :weight bold)))
+  "Face used to highlight B<> formatting codes in POD"
+  :group 'pod-mode-faces)
+
+(defface pod-mode-alternative-formatting-code-face
+  '((((class color) (min-colors 88) (background light)) (:foreground "Blue1"))
+    (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue"))
+    (((class color) (min-colors 16) (background light)) (:foreground "Blue"))
+    (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue"))
+    (((class color) (min-colors 8)) (:foreground "blue" :weight bold))
+    (t (:inverse-video t :weight bold)))
+  "Alternative face used to highlight formatting codes in POD.
+This is used for E<> escapes and for the link target in L<>
+escapes."
+  :group 'pod-mode-faces)
+
+(defface pod-mode-string-face
+  '((((class grayscale) (background light)) (:foreground "DimGray" :slant italic))
+    (((class grayscale) (background dark)) (:foreground "LightGray" :slant italic))
+    (((class color) (min-colors 88) (background light)) (:foreground "VioletRed4"))
+    (((class color) (min-colors 88) (background dark)) (:foreground "LightSalmon"))
+    (((class color) (min-colors 16) (background light)) (:foreground "RosyBrown"))
+    (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon"))
+    (((class color) (min-colors 8)) (:foreground "green"))
+    (t (:slant italic)))
+  "Face used to highlight quoted strings in POD"
+  :group 'pod-mode-faces)
+
+(defvar pod-mode-hook nil
+  "List of functions to be called when activating `pod-mode'.")
+
+;;; Version: 1.01
+(defvar pod-version "1.01"
+  "Version of POD mode.")
+
+(let* ((head-sizes '(1.9 1.7 1.5 1.3))
+       (heads (loop for i from 1 to (length head-sizes) collect
+                    (cons i (nth (- i 1) head-sizes)))))
+  (defconst pod-font-lock-keywords-1
+    (append
+     (loop for (n . s) in heads collect
+           (let ((head-face-name (intern (format "pod-mode-head%d-face" n)))
+                 (text-face-name (intern (format "pod-mode-head%d-text-face" n))))
+             (eval `(defface ,head-face-name
+                      '((t (:inherit pod-mode-head-face :height ,s)))
+                      ,(format "Face used to highlight head%d commands" n)
+                      :group 'pod-mode-faces))
+             (eval `(defface ,text-face-name
+                      '((t (:inherit pod-mode-command-text-face :height ,s)))
+                      ,(format "Face used to hightlight text in head%d commands" n)
+                      :group 'pod-mode-faces))
+             `(,(format "^\\(=head%d\\)\\(.*\\)" n)
+               (1 (quote ,head-face-name))
+               (2 (quote ,text-face-name)))))
+     `((,(format "^\\(=%s\\)\\(.*\\)"
+                 (regexp-opt '("item" "over" "back" "cut" "pod"
+                               "for" "begin" "end" "encoding")))
+        (1 'pod-mode-command-face)
+        (2 'pod-mode-command-text-face))))
+    "Minimal highlighting expressions for POD mode."))
+
+(defconst pod-font-lock-keywords-2
+  (append pod-font-lock-keywords-1 '())
+  "Additional Keywords to highlight in POD mode.")
+
+(defun pod-matcher-for-code (code body)
+  "Create a matcher function for a given POD formatting CODE.
+Will return a quoted lambda as expected by `font-lock-keywords'
+as MATCHER.
+
+When executing the lambda, it will match a POD formatting code
+introduced with the character CODE and as described in perlpod.
+
+BODY is expected to be a quoted lambda.  It will be executed
+after a successful match of a well-balanced formatting code.
+It'll get two arguments, the start and end position of the text
+contained in the formatting code.  It should return a list of
+positions suitable to use as match data for later highlighting by
+`font-lock-keywords'."
+  `(lambda (limit)
+     (when (re-search-forward
+            ,(concat
+              code
+              "\\(?:\\(?:\\(<\\)[^<]\\)\\|\\(?:\\(<\\{2,\\}\\)\s\\)\\)")
+            limit t)
+       (let ((beg (or (match-end 1)
+                      (match-end 2)))
+             (n-lt (length (or (match-string-no-properties 1)
+                               (match-string-no-properties 2)))))
+         (goto-char (- (point) 1))
+         (when (re-search-forward
+                (concat (when (> n-lt 1) "\s")
+                        "\\("
+                        (apply 'concat (loop for i from 1 to n-lt collect ">"))
+                        "\\)")
+                limit t)
+           (let* ((end (match-beginning 1))
+                  (match-data (funcall ,body beg end)))
+             (when (match-data)
+               (store-match-data (append
+                                  (list (- beg n-lt 1) beg)
+                                  match-data
+                                  (list end (+ end n-lt))))
+               t)))))))
+
+(defun pod-keyword-for-simple-code (code face)
+  "Build a `font-lock-keywords' keyword for a POD formatting code.
+CODE is the character introducing the formatting code to be
+matched.  FACE is the face that should be used to map the text
+within the formattign code.
+
+In addition to matching the code's content with FACE, the
+formatting code itself will be highlighted using
+`pod-mode-formatting-code-character-face'."
+  `(,(pod-matcher-for-code code '(lambda (beg end)
+                                   (list beg end)))
+    (0 'pod-mode-formatting-code-character-face prepend)
+    (1 ',face append)
+    (2 'pod-mode-formatting-code-character-face prepend)))
+
+(defconst pod-font-lock-keywords-3
+  (append pod-font-lock-keywords-2
+          (loop for code in '("C" "F" "X" "Z" "S")
+                collect (pod-keyword-for-simple-code
+                         code 'pod-mode-formatting-code-face))
+          (list
+           (pod-keyword-for-simple-code
+            "E" 'pod-mode-alternative-formatting-code-face)
+           (pod-keyword-for-simple-code "I" 'pod-mode-formatting-code-i-face)
+           (pod-keyword-for-simple-code "B" 'pod-mode-formatting-code-b-face)
+           `(,(pod-matcher-for-code
+               "L" (lambda (beg end)
+                     (goto-char beg)
+                     (if (re-search-forward "\\([^|]\\)|" end t)
+                         (list beg (match-end 1)
+                               (+ (match-end 1) 1) end)
+                       (list 0 0 beg end))))
+             (0 'pod-mode-formatting-code-character-face prepend)
+             (1 'pod-mode-formatting-code-face append)
+             (2 'pod-mode-alternative-formatting-code-face append)
+             (3 'pod-mode-formatting-code-character-face prepend))
+           '("\"\\([^\"]+\\)\""
+             (0 'pod-mode-string-face))
+           '("^[ \t]+\\(.*\\)$" 1 'pod-mode-verbatim-face prepend)))
+  "Balls-out highlighting in POD mode.")
+
+(defvar pod-font-lock-keywords pod-font-lock-keywords-3
+  "Default highlighting expressions for POD mode.")
+
+(defvar pod-weaver-section-keywords nil
+  "List of custom Pod::Weaver keywords describing sections.
+This is an alist, mapping strings with pod commands to a number
+describing their level within the document.")
+(make-local-variable 'pod-weaver-section-keywords)
+
+(defun pod-linkable-sections-for-buffer (buffer &optional section-keywords)
+  "Extract POD sections from BUFFER.
+Returns a list of POD section names with BUFFER.  By default only
+=head commands are looked for.  The optional second argument
+SECTION-KEYWORDS may be used to also extract section names from
+additional pod commands."
+  (with-current-buffer buffer
+    (save-excursion
+      (save-match-data
+        (goto-char (point-min))
+        (loop while (re-search-forward
+                     (format "^=%s\s+\\(.*\\)$"
+                             (regexp-opt
+                              (append
+                               (loop for i from 1 to 4
+                                     collect (format "head%d" i))
+                               '("item")
+                               section-keywords)))
+                     nil t)
+              collect (match-string-no-properties 1))))))
+
+(defun pod-linkable-sections-for-module (module)
+  "Extract POD sections from MODULE.
+Opens the documentation of an installed perl MODULE and returns a
+list of all section names in it.
+
+`pod-linkable-sections-for-buffer' is used to actually extract
+the sections."
+  (with-current-buffer (get-buffer-create (concat "*POD " module "*"))
+    (unwind-protect
+        (progn
+          (kill-all-local-variables)
+          (erase-buffer)
+          (text-mode)
+          (let ((default-directory "/"))
+            (call-process "perldoc" nil (current-buffer) nil "-T" "-u" module)
+            (goto-char (point-min))
+            (when (and (> (count-lines (point-min) (point-max)) 1)
+                       (not (re-search-forward
+                             "No documentation found for .*" nil t)))
+              (pod-linkable-sections-for-buffer (current-buffer)))))
+      (kill-buffer (current-buffer)))))
+
+(defun pod-linkable-sections (&optional module)
+  "Extract POD sections.
+Extracts all POD sections from either the current buffer, or, if
+MODULE is given, from the POD documentation of an installed
+module.
+
+If MODULE is given, `pod-linkable-sections-for-module' will be
+called.  Otherwise `pod-linkable-sections-for-buffer' for
+`current-buffer', and with all additional POD section keywords as
+provided by `pod-weaver-section-keywords'."
+  (if module
+      (pod-linkable-sections-for-module module)
+    (pod-linkable-sections-for-buffer
+     (current-buffer)
+     (mapcar (lambda (i) (car i))
+             pod-weaver-section-keywords))))
+
+(defun pod-linkable-modules (&optional re-cache)
+  "Find all installed perl modules.
+Returns a list of all installed perl modules, as provided by
+function `perldoc-modules-alist'.  This requires `perldoc' to be
+loadable.
+
+If the optional argument RE-CACHE is non-nil, a possibly cached
+version of the module list will be discarded and rebuilt."
+  (save-current-buffer
+    (when (ignore-errors (require 'perldoc))
+      (when (or re-cache (not perldoc-modules-alist))
+        (message "Building completion list of all perl modules..."))
+      (mapcar (lambda (i) (car i)) (perldoc-modules-alist re-cache)))))
+
+(defun pod-link (link &optional text)
+  "Insert a POD hyperlink formatting code.
+Inserts a POD L<> formatting code at point.  The content of the
+code will be LINK.
+
+If the optional argument TEXT is a string and contains anything
+that's not whitespace, it will be used as the link title."
+  (insert (concat "L<"
+                  (when (and (stringp text)
+                             (string-match-p "[^\s]" text))
+                    (concat text "|"))
+                  link
+                  ">")))
+
+(defun pod-completing-read (prompt choices)
+  "Use `completing-read' to do a completing read."
+  (completing-read prompt choices))
+
+(defun pod-icompleting-read (prompt choices)
+  "Use iswitchb to do a completing read."
+  (let ((iswitchb-make-buflist-hook
+         (lambda ()
+           (setq iswitchb-temp-buflist choices))))
+    (unwind-protect
+        (progn
+          (when (not iswitchb-mode)
+            (add-hook 'minibuffer-setup-hook 'iswitchb-minibuffer-setup))
+          (iswitchb-read-buffer prompt))
+      (when (not iswitchb-mode)
+        (remove-hook 'minibuffer-setup-hook 'iswitchb-minibuffer-setup)))))
+
+(defun pod-ido-completing-read (prompt choices)
+  "Use ido to do a completing read."
+  (ido-completing-read prompt choices))
+
+(defcustom pod-completing-read-function
+  #'pod-icompleting-read
+  "Ask the user to select a single item from a list.
+Used by `pod-link-section', `pod-link-module', and
+`pod-link-module-section'."
+  :group 'pod-mode
+  :type '(radio (function-item
+                 :doc "Use Emacs' standard `completing-read' function."
+                 pod-completing-read)
+                (function-item :doc "Use iswitchb's completing-read function."
+                               pod-icompleting-read)
+                (function-item :doc "Use ido's completing-read function."
+                               pod-ido-completing-read)
+                (function)))
+
+(defun pod-do-completing-read (&rest args)
+  "Do a completing read with the configured `pod-completing-read-function'."
+  (apply pod-completing-read-function args))
+
+(defun pod-link-uri (uri &optional text)
+  "Insert POD hyperlink formatting code for a URL.
+Calls `pod-link' with URI and TEXT.
+
+When called interactively, URI and TEXT will be read from the
+minibuffer."
+  (interactive
+   (list (read-string "URI: ")
+         (read-string "Text: ")))
+  (pod-link uri text))
+
+(defun pod-link-section (section &optional text)
+  "Insert hyperlink formatting code for a POD section.
+Insert an L<> formatting code pointing to a section within the
+current document.
+
+When called interactively, SECTION and TEXT will be read using
+`pod-do-completing-read'.
+
+When reading SECTION, `pod-linkable-sections' will be used to
+provide completions."
+  (interactive
+   (list (pod-do-completing-read "Section: " (pod-linkable-sections))
+         (read-string "Text: ")))
+  (pod-link-module-section "" section text))
+
+(defun pod-link-module (module &optional text)
+  "Insert POD hyperlink formatting code for a module.
+Insert an L<> formatting code pointing to a MODULE.
+
+When called interactively, MODULE and TEXT will be read using
+`pod-do-completing-read'.
+
+When reading MODULE, `pod-linkable-modules' will be used to
+provide completions."
+  (interactive
+   (list (pod-do-completing-read "Module: "
+                                 (pod-linkable-modules current-prefix-arg))
+         (read-string "Text: ")))
+  (pod-link module text))
+
+(defun pod-link-module-section (module section &optional text)
+  "Insert POD hyperlink formatting code for a section in a module.
+Insert an L<> formatting code pointing to a part of MODULE
+documentation as described by SECTION.
+
+When called interactive, MODULE, SECTION, and TEXT will be read
+using `pod-do-completing-read'.
+
+When reading MODULE and SECTION, `pod-linkable-modules' and
+`pod-linkable-sections', respectively, will be used to provide
+completions."
+  (interactive
+   (let ((module (pod-do-completing-read
+                  "Module: "
+                  (pod-linkable-modules current-prefix-arg))))
+     (list module
+           (pod-do-completing-read "Section: " (pod-linkable-sections module))
+           (read-string "Text: "))))
+  (pod-link
+   (concat module
+           "/"
+           (if (string-match-p "\s" section)
+               (concat "\"" section "\"")
+             section))
+   text))
+
+(defvar pod-mode-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map (kbd "C-c C-l u") 'pod-link-uri)
+    (define-key map (kbd "C-c C-l s") 'pod-link-section)
+    (define-key map (kbd "C-c C-l m") 'pod-link-module)
+    (define-key map (kbd "C-c C-l M") 'pod-link-module-section)
+    map)
+  "Keymap for POD major mode.")
+
+(defvar pod-mode-syntax-table
+  (let ((st (make-syntax-table)))
+    st)
+  "Syntax table for `pod-mode'.")
+
+(defun pod-add-support-for-outline-minor-mode (&rest sections)
+  "Provides additional menus from section commands for function
+`outline-minor-mode'.
+
+SECTIONS can be used to supply section commands in addition to
+the POD defaults."
+  (make-local-variable 'outline-regexp)
+  (setq outline-regexp
+        (format "=%s\s"
+         (regexp-opt
+          (append (loop for i from 1 to 4 collect (format "head%d" i))
+                  '("item") sections))))
+  (make-local-variable 'outline-level)
+  (setq outline-level
+        (lambda ()
+          (save-excursion
+            (save-match-data
+              (let ((sect (format "^=%s\s"
+                                  (regexp-opt
+                                   (mapcar (lambda (i) (car i))
+                                           pod-weaver-section-keywords) t))))
+                (cond
+                 ((looking-at sect)
+                  (cdr (assoc (match-string-no-properties 1)
+                              pod-weaver-section-keywords)))
+                 ((looking-at "^=item\s") 5)
+                 ((string-to-number (buffer-substring
+                                     (+ (point) 5)
+                                     (+ (point) 6)))))))))))
+
+(defun pod-add-support-for-imenu (&rest sections)
+  "Set up `imenu-generic-expression' for pod section commands.
+SECTIONS can be used to supply section commands in addition to
+the POD defaults."
+  (setq imenu-generic-expression
+        `((nil ,(format "^=%s\s+\\(.*\\)"
+                        (regexp-opt
+                         (append
+                          (loop for i from 1 to 4 collect (format "head%d" i))
+                          '("item") sections)))
+               1))))
+
+(defun pod-enable-weaver-collector-keywords (collectors)
+  "Enable support for Pod::Weaver collector commands.
+Enables fontification for all commands described by COLLECTORS.
+
+Also updates `pod-weaver-section-keywords', `outline-regexp', and
+`imenu-generic-expression' accordingly."
+  (let ((collectors-by-replacement))
+    (save-match-data
+      (setf pod-weaver-section-keywords
+            (loop for col in collectors
+                  with cmd with new-cmd with new-name
+                  do (progn
+                       (setq cmd (getf col 'command)
+                             new-cmd (getf col 'new_command)
+                             new-name (symbol-name new-cmd))
+                       (let ((pos (loop for i in collectors-by-replacement do
+                                        (when (equal (car i) new-cmd)
+                                          (return i)))))
+                         (if (not pos)
+                             (push (list new-cmd cmd) collectors-by-replacement)
+                           (setcdr (last pos) (list cmd)))))
+                  when (string-match "^head\\([1-4]\\)$" new-name)
+                  collect (cons (symbol-name cmd)
+                                (string-to-number
+                                 (match-string-no-properties 1 new-name)))
+                  when (string-match "^item$" new-name)
+                  collect (cons (symbol-name cmd) 5))))
+    (let ((sections (mapcar (lambda (i) (car i))
+                            pod-weaver-section-keywords)))
+      (apply #'pod-add-support-for-outline-minor-mode sections)
+      (apply #'pod-add-support-for-imenu sections))
+    (setf
+     pod-font-lock-keywords
+     (append
+      (mapcar (lambda (i)
+                (append
+                 (list (format "^\\(=%s\\)\\(.*\\)"
+                               (regexp-opt (mapcar (lambda (k) (symbol-name k))
+                                                   (cdr i)))))
+                 (let ((n (symbol-name (car i))))
+                   (if (string-match-p "^head[1-4]$" n)
+                       (list
+                        `(1 (quote
+                             ,(intern (format "pod-mode-%s-face" n))))
+                        `(2 (quote
+                             ,(intern (format "pod-mode-%s-text-face" n)))))
+                     (list
+                      '(1 'pod-mode-command-face)
+                      '(2 'pod-mode-command-text-face))))))
+              collectors-by-replacement)
+      pod-font-lock-keywords))
+    (setq font-lock-mode-major-mode nil)
+    (font-lock-fontify-buffer)))
+
+(defun pod-enable-weaver-features (buffer weaver-config)
+  "Enable support for Pod::Weaver features.
+Enables support for custom Pod::Weaver commands within a BUFFER.
+
+WEAVER-CONFIG is a structure as returned by
+\"dzil weaverconf -f lisp\".
+
+Currently only supports collector commands via
+`pod-enable-weaver-collector-keywords'."
+  (with-current-buffer buffer
+    (pod-enable-weaver-collector-keywords (getf weaver-config 'collectors))
+    (message "Pod::Weaver keywords loaded.")))
+
+(defun pod-load-weaver-config (dir)
+  "Load additional pod keywords from dist.ini/weaver.ini in DIR."
+  (let* ((proc (start-process-shell-command
+                (concat "weaverconf-" (buffer-name (current-buffer)))
+                nil (format "cd %s; dzil weaverconf -f lisp" dir))))
+    (set-process-plist proc (list :buffer (current-buffer)
+                                  :output ""))
+    (set-process-filter
+     proc (lambda (proc str)
+            (let ((plist (process-plist proc)))
+              (plist-put plist :output (concat (plist-get plist :output) str)))))
+    (set-process-sentinel
+     proc (lambda (proc event)
+            (if (string-equal event "finished\n")
+                (let* ((plist (process-plist proc))
+                       (weaver-config
+                        (ignore-errors
+                          (eval (car (read-from-string
+                                      (plist-get plist :output)))))))
+                  (if weaver-config (pod-enable-weaver-features
+                                     (plist-get (process-plist proc) :buffer)
+                                     weaver-config))))))))
+
+(defun pod-add-support-for-weaver ()
+  "Enable support for Pod::Weaver features in the current buffer.
+Calls `pod-load-weaver-config' with the project directory of the
+current buffer's file.  To be able to successfully determine the
+project directory, `eproject-maybe-turn-on' will be used and
+'eproject.el' is expected to be loaded.
+
+Does nothing if finding the project directory fails."
+  (let ((project-root (ignore-errors (eproject-maybe-turn-on))))
+    (if project-root (pod-load-weaver-config project-root))))
+
+;;;###autoload
+(defun pod-mode ()
+  "Major mode for editing POD files (Plain Old Documentation for Perl).
+
+Commands:\\
+\\[pod-link]  `pod-link'
+\\[pod-link-section]     `pod-link-section'
+\\[pod-link-module]     `pod-link-module'
+\\[pod-link-module-section]     `pod-link-module-section'
+
+Turning on pod mode calls the hooks in `pod-mode-hook'."
+  (interactive)
+  (kill-all-local-variables)
+  (set-syntax-table pod-mode-syntax-table)
+  (use-local-map pod-mode-map)
+  (make-local-variable 'font-lock-defaults)
+  (setq font-lock-defaults '(pod-font-lock-keywords 't))
+  (setq major-mode 'pod-mode)
+  (setq mode-name "POD")
+  (pod-add-support-for-imenu)
+  (pod-add-support-for-outline-minor-mode)
+  (run-hooks 'pod-mode-hook)
+  (pod-add-support-for-weaver))
+
+(provide 'pod-mode)
+
+;;; pod-mode.el ends here
diff --git a/elisp/emacs-goodies-el/pp-c-l.el b/elisp/emacs-goodies-el/pp-c-l.el
new file mode 100755
index 0000000..203cb72
--- /dev/null
+++ b/elisp/emacs-goodies-el/pp-c-l.el
@@ -0,0 +1,265 @@
+;;; pp-c-l.el --- Display Control-l characters in a pretty way
+;; 
+;; Filename: pp-c-l.el
+;; Description: Display Control-l characters in a buffer in a pretty way
+;; Author: Drew Adams
+;; Maintainer: Drew Adams
+;; Copyright (C) 2007-2010, Drew Adams, all rights reserved.
+;; Created: Thu Feb 08 20:28:09 2007
+;; Version: 1.0
+;; Last-Updated: Wed Apr 28 14:32:49 2010 (-0700)
+;;           By: dradams
+;;     Update #: 196
+;; URL: http://www.emacswiki.org/cgi-bin/wiki/pp-c-l.el
+;; Keywords: display, convenience, faces
+;; Compatibility: GNU Emacs: 20.x, 21.x, 22.x, 23.x
+;; 
+;; Features that might be required by this library:
+;;
+;;   None
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; 
+;;; Commentary: 
+;; 
+;;  Faces defined here:
+;;
+;;    `pp^L-highlight'.
+;;
+;;  User options defined here:
+;;
+;;    `pp^L-^L-string', `pp^L-^L-string-function',
+;;    `pp^L-^L-string-post', `pp^L-^L-string-pre',
+;;    `pretty-control-l-mode'.
+;;
+;;  Commands defined here:
+;;
+;;    `pp^l', `pretty-control-l-mode', `refresh-pretty-control-l'.
+;;
+;;  Non-interactive functions defined here:
+;;
+;;   `pp^L-^L-display-table-entry', `pp^L-make-glyph-code'.
+;;
+;;
+;;  To use this library, add this to your initialization file
+;;  (~/.emacs or ~/_emacs):
+;;
+;;    (require 'pp-c-l)           ; Load this library.
+;;
+;;  To turn on this mode by default, then either customize option
+;;  `pretty-control-l-mode' to non-nil or add this line also to your
+;;  init file:
+;;
+;;    (pretty-control-l-mode 1)   ; Turn on pretty display of `^L'.
+;;
+;;  For most of the user options defined here, if you change the value
+;;  then you will need to re-enter `pretty-control-l-mode', for the
+;;  new value to take effect.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; 
+;;; Change log:
+;;
+;; 2010/04/28 dadams
+;;     Added autoload cookie for pp^L-^L-display-table-entry.  Thx to Peter Galbraith.
+;; 2010/04/08 dadams
+;;     Added autoload cookies.  Thx to Peter Galbraith.
+;; 2009/03/02 dadams
+;;     Enhancement by Andrey Paramonov.
+;;       pp^L-^L-display-table-entry: Added window argument.
+;;       pretty-control-l-mode: Update display table of each window.
+;;                              Add/remove refresh to window-configuration-hook.
+;;       refresh-pretty-control-l: Just call mode function when turned on.
+;; 2009/02/26 dadams
+;;     Added: pp^L-^L-string-function, refresh-pretty-control-l.
+;;     pp^L-^L-display-table-entry: Use pp^L-^L-string-function if non-nil.
+;; 2008/05/02 dadams
+;;     pp^L-make-glyph-code: If make-glyph-code exists, use that (alias).
+;; 2007/05/28 dadams
+;;     pp^L-make-glyph-code: Reported Emacs 23 bug to Emacs.
+;;       Fixed to work also with Emacs 23+, per Kenichi Handa's suggestion.  
+;; 2007/02/08 dadams
+;;     Created.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; 
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or
+;; (at your option) any later version.
+;; 
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+;; 
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING.  If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;; 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; 
+;;; Code:
+
+;;;;;;;;;;;;;;;;;;;;
+
+;; Convenience function suggested by Kim Storm to emacs-devel@gnu.org, in response to
+;; my email 2007-02-05, subject: "cannot understand Elisp manual node Glyphs".
+;; Added to Emacs as `make-glyph-code' starting with Emacs 23.
+;; The version here works also for Emacs versions before Emacs 23.
+;; The constant passed as second arg to lsh must be the same as constant
+;; CHARACTERBITS in `src/lisp.h'.
+(if (fboundp 'make-glyph-code)
+    (defalias 'pp^L-make-glyph-code 'make-glyph-code)
+  (defun pp^L-make-glyph-code (char &optional face)
+    "Return a glyph code representing char CHAR with face FACE."
+    (if face
+        (logior char (lsh (face-id face) 19)) ; CHARACTERBITS
+      char)))
+
+;;;###autoload
+(defgroup Pretty-Control-L nil
+  "Options to define pretty display of Control-l (`^L') characters."
+  :prefix "pp^L-" :group 'convenience :group 'wp
+  :link `(url-link :tag "Send Bug Report"
+          ,(concat "mailto:" "drew.adams" "@" "oracle" ".com?subject=pp-c-l.el bug: \
+&body=Describe bug here, starting with `emacs -q'.  \
+Don't forget to mention your Emacs and library versions."))
+  :link '(url-link :tag "Other Libraries by Drew"
+          "http://www.emacswiki.org/cgi-bin/wiki/DrewsElispLibraries")
+  :link '(url-link :tag "Download" "http://www.emacswiki.org/cgi-bin/wiki/pp-c-l.el")
+  :link '(url-link :tag "Description"
+          "http://www.emacswiki.org/cgi-bin/wiki/PrettyControlL")
+  :link '(emacs-commentary-link :tag "Commentary" "pp-c-l"))
+
+;;;###autoload
+(defface pp^L-highlight
+    (if (> emacs-major-version 21)
+        '((((type x w32 mac graphic) (class color))
+           (:box (:line-width 3 :style pressed-button)))
+          (t (:inverse-video t)))
+      '((((type x w32 mac graphic) (class color))
+         (:foreground "Blue" :background "DarkSeaGreen1"))
+        (t (:inverse-video t))))
+  "*Face used to highlight `pp^L-^L-vector'."
+  :group 'Pretty-Control-L :group 'faces)
+
+;;;###autoload
+(defcustom pp^L-^L-string "          Section (Printable Page)          "
+  "*Highlighted string displayed in place of each Control-l (^L) character.
+If `pp^L-^L-string-function' is non-nil, then the string that function
+returns is used instead of `pp^L-^L-string'."
+  :type 'string :group 'Pretty-Control-L)
+
+(defcustom pp^L-^L-string-function nil
+  "*Function to produce string displayed in place of a Control-l (^L) char.
+The function accepts as argument the window where the ^L is displayed.
+If the option value is non-nil, option `pp^L-^L-string' is not used.
+You can use this option to have a dynamically defined display string.
+For example, this value displays a window-width horizontal line:
+  (lambda (win) (make-string (1- (window-width win)) ?_))"
+  :type '(choice (const :tag "None" nil) function) :group 'Pretty-Control-L)
+
+(defcustom pp^L-^L-string-pre (if (> emacs-major-version 21) "\n" "")
+  "*String displayed just before `pp^L-^L-string'.
+This text is not highlighted."
+  :type 'string :group 'Pretty-Control-L)
+
+(defcustom pp^L-^L-string-post ""
+  "*String displayed just after `pp^L-^L-string'.
+This text is not highlighted."
+  :type 'string :group 'convenience :group 'wp)
+
+;;;###autoload
+(unless (fboundp 'define-minor-mode)    ; Emacs 20.
+  (defcustom pretty-control-l-mode nil
+    "*Toggle pretty display of Control-l (`^L') characters.
+Setting this variable directly does not take effect;
+use either \\[customize] or command `pretty-control-l-mode'."
+    :set (lambda (symbol value) (pretty-control-l-mode (if value 1 -1)))
+    :initialize 'custom-initialize-default
+    :type 'boolean :group 'Pretty-Control-L))
+
+;;;###autoload
+(defun pp^L-^L-display-table-entry (window)
+  "Returns the display-table entry for Control-l (`^L') char in WINDOW.
+A vector determining how a Control-l character is displayed in WINDOW.
+Either a vector of characters or nil.  The characters are displayed in
+place of the Control-l character.  nil means `^L' is displayed.
+
+In effect, this concatenates `pp^L-^L-string-pre', `pp^L-^L-string',
+and `pp^L-^L-string-post'."
+  (vconcat (mapconcat (lambda (c) (list c)) pp^L-^L-string-pre "")
+           (mapcar (lambda (c) (pp^L-make-glyph-code c 'pp^L-highlight))
+                   (if pp^L-^L-string-function
+                       (funcall pp^L-^L-string-function window)
+                     pp^L-^L-string))
+           (mapconcat (lambda (c) (list c)) pp^L-^L-string-post "")))
+
+(defalias 'pp^l 'pretty-control-l-mode)
+;;;###autoload
+(if (fboundp 'define-minor-mode)
+    ;; Emacs 21 and later.
+    ;; We eval this so that even if the library is byte-compiled with Emacs 20,
+    ;; loading it into Emacs 21+ will define variable `pretty-control-l-mode'.
+    (eval '(define-minor-mode pretty-control-l-mode
+            "Toggle pretty display of Control-l (`^L') characters.
+With ARG, turn pretty display of `^L' on if and only if ARG is positive."
+            :init-value nil :global t :group 'Pretty-Control-L
+            :link `(url-link :tag "Send Bug Report"
+                    ,(concat "mailto:" "drew.adams" "@" "oracle" ".com?subject=\
+pp-c-l.el bug: \
+&body=Describe bug here, starting with `emacs -q'.  \
+Don't forget to mention your Emacs and library versions."))
+            :link '(url-link :tag "Other Libraries by Drew"
+                    "http://www.emacswiki.org/cgi-bin/wiki/DrewsElispLibraries")
+            :link '(url-link :tag "Download"
+                    "http://www.emacswiki.org/cgi-bin/wiki/pp-c-l.el")
+            :link '(url-link :tag "Description"
+                    "http://www.emacswiki.org/cgi-bin/wiki/PrettyControlL")
+            :link '(emacs-commentary-link :tag "Commentary" "pp-c-l")
+            (if pretty-control-l-mode
+                (add-hook 'window-configuration-change-hook 'refresh-pretty-control-l)
+              (remove-hook 'window-configuration-change-hook 'refresh-pretty-control-l))
+            (walk-windows 
+ 	     (lambda (window)
+ 	       (let ((display-table  (or (window-display-table window)
+                                         (make-display-table))))
+ 		 (aset display-table ?\014 (and pretty-control-l-mode
+                                                (pp^L-^L-display-table-entry window)))
+ 		 (set-window-display-table window display-table)))
+             'no-minibuf
+             'visible)))
+
+  ;; Emacs 20
+  (defun pretty-control-l-mode (&optional arg)
+    "Toggle pretty display of Control-l (`^L') characters.
+With ARG, turn pretty display of `^L' on if and only if ARG is positive."
+    (interactive "P")
+    (setq pretty-control-l-mode
+          (if arg (> (prefix-numeric-value arg) 0) (not pretty-control-l-mode)))
+    (if pretty-control-l-mode
+        (add-hook 'window-configuration-change-hook 'refresh-pretty-control-l)
+      (remove-hook 'window-configuration-change-hook 'refresh-pretty-control-l))
+    (walk-windows 
+     (lambda (window)
+       (let ((display-table  (or (window-display-table window) (make-display-table))))
+         (aset display-table ?\014 (and pretty-control-l-mode
+                                        (pp^L-^L-display-table-entry window)))
+         (set-window-display-table window display-table)))
+     'no-minibuf
+     'visible)))
+
+;;;###autoload
+(defun refresh-pretty-control-l ()
+  "Reinitialize `pretty-control-l-mode', if on, to update the display."
+  (interactive)
+  (when pretty-control-l-mode (pretty-control-l-mode t)))
+  
+;;;;;;;;;;;;;;;;;;;;
+
+(provide 'pp-c-l)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; pp-c-l.el ends here
diff --git a/elisp/emacs-goodies-el/projects.el b/elisp/emacs-goodies-el/projects.el
new file mode 100755
index 0000000..1f60f5d
--- /dev/null
+++ b/elisp/emacs-goodies-el/projects.el
@@ -0,0 +1,234 @@
+;;; projects.el -- Project-based buffer name management
+
+;; Copyright 1998 Naggum Software
+;; Copyright 2003 Peter S Galbraith 
+
+;; Author: Erik Naggum 
+;; Maintainer: Peter S Galbraith 
+;;  Erik Naggum died on June 17, 2009.  I will therefofre maintain this
+;;  since it was already packaged in Debian, but contact me if you would
+;;  like to take over.  - Peter
+;; Keywords: internal
+
+;; This file is not part of GNU Emacs, but distributed under the same
+;; conditions as GNU Emacs, and is useless without GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Managing a large number of buffers that visit files in many directories
+;; (such as both local and remote copies of sources) can be confusing when
+;; there are files with similar or even identical names and the buffers end
+;; up being named foobar.cl<19> or like unintuitiveness.  This package
+;; introduces the concept of PROJECT ROOTS that allow the programmer to
+;; define what looks suspiciously like logical pathname hosts from Common
+;; Lisp and get abbreviated yet meaningful buffer names in the modeline.
+
+;; Commands include PROJECT-ADD, which takes a project name and a directory
+;; (which conveniently defaults to the current directory), PROJECT-REMOVE
+;; (which completes on existing projects), and PROJECT-LIST, which lists the
+;; current projects in a rudimentary table.  PROJECT-UPDATE-BUFFER-NAMES is
+;; called automatically when either PROJECT-ADD or PROJECT-REMOVE changes
+;; the project list, but may also be called by the user as a command.
+
+;; Variables include PROJECT-ROOT-ALIST, which contains the list of current
+;; projects and their root directories, and two variables that control the
+;; naming of buffers: PROJECT-BUFFER-NAME-DIRECTORY-LIMIT, the uppper limit
+;; on the number of characters in the last few directory elements in the
+;; pathname that makes up the buffer name and
+;; PROJECT-BUFFER-NAME-DIRECTORY-PREFIX, the string prepended to buffer
+;; names that would be too long.
+
+;; Internal functions include PROJECT-BUFFER-NAME, which computes the
+;; buffer name from the filename argument, PROJECT-ROOT-ALIST, which
+;; computes a sorted list of projects on their directories and maintains a
+;; cache because this operation is expensive, and a redefinition of the
+;; function CREATE-FILE-BUFFER, which is called to create new file-visiting
+;; buffers.  Note that the latter may still produce ..., if truly
+;; identical buffer names are requested.  This may happen if you call dired
+;; on a filename and then visit the same file.  Use C-x C-v M-p instead.
+
+;; Loading this file is sufficient to install the package.
+;; Reloading has no effect.
+
+;;; History:
+
+;; 2003-10-27 Peter S Galbraith 
+;;
+;;  I tried to contact the author but his host is down.  I like the concept
+;;  of prefixing certain buffer names with a project name, but not renaming
+;;  all unrelated buffers with the full directory path.  This breaks MH-E
+;;  mail folder names for example.  So I'm introducing the variable
+;;  `project-rename-all-buffers' with a default of nil.  You may customize
+;;  this to obtain the old behaviour.
+;;
+;;  In addition, I am renaming commands:
+;;
+;;    `add-project'    to `project-add'
+;;    `remove-project' to `project-remove'.
+;;    `list-projects'  to `project-list'.
+;;    `update-buffer-names' to `project-update-buffer-names'
+;;
+;;  variables (also made into defcustoms):
+;;
+;;    `buffer-name-directory-limit' to `project-buffer-name-directory-limit'
+;;    `buffer-name-directory-prefix' to `project-buffer-name-directory-prefix'
+
+;;; Code:
+
+(require 'cl)
+
+(provide 'projects)
+
+(defgroup projects nil
+  "Project-based buffer name management."
+  :group 'convenience)
+
+(defcustom project-rename-all-buffers nil
+  "*Whether to rename buffer not belonging to a project."
+  :type 'boolean
+  :group 'projects)
+
+(defcustom project-buffer-name-directory-limit 20
+  "*Directories in buffer names are attempted kept shorter than this."
+  :type 'integer
+  :group 'projects)
+
+(defcustom project-buffer-name-directory-prefix "<"
+  "*String to prepend to an abbreviated buffer name."
+  :type 'string
+  :group 'projects)
+
+;; External symbols
+
+(defvar project-root-alist nil
+  "Alist of projects and their root directories.
+The key should be a (short) project name.
+The value should be the project's root directory.
+Multiple projects in the same hierarchy is handled correctly.")
+
+;;;###autoload
+(defun project-add (name directory)
+  "Add the project named NAME with root directory DIRECTORY."
+  (interactive "sName of project: \nDDirectory of project %s: ")
+  (push (cons name directory) project-root-alist)
+  (message "Project `%s' maps to `%s'" name directory)
+  (project-update-buffer-names))
+
+(defun project-remove (name)
+  "Remove the project named NAME."
+  (interactive
+   (list (completing-read "Name of project: " project-root-alist nil t)))
+  (setf project-root-alist
+    (remove* name project-root-alist :key #'car :test #'equal))
+  (project-update-buffer-names))
+
+(defun project-list (&optional sort-by-root)
+  "List all projects sorted by project name.
+If optional argument SORT-BY-ROOT is true, sort by project root, instead."
+  (interactive "P")
+  (let* ((project-list
+	  (sort* (copy-list (project-root-alist))
+		 #'string< :key (if sort-by-root #'cdr #'car)))
+	 (longest
+	  (loop for (name) in project-list maximize (length name))))
+    (if project-list
+      (with-output-to-temp-buffer "*Help*"
+	(princ "Current projects and their root directories:\n\n")
+	(loop for (name . dir) in project-list do
+	      (princ name)
+	      (princ ":")
+	      (princ (make-string (- (max 6 longest) -2 (length name)) ?\ ))
+	      (princ (file-truename dir))
+	      (terpri)))
+      (message "There are no projects."))))
+
+(defun project-update-buffer-names (&rest buffers)
+  "Update the name of the indicated BUFFERS.
+Interactively, or if no buffers are given, the names of all file-visiting
+buffers are updated according to the new value of PROJECT-ROOT-ALIST."
+  (interactive)
+  (dolist (buffer (or buffers (buffer-list)))
+    (with-current-buffer buffer
+      (when buffer-file-name
+	(setf (buffer-name) (project-buffer-name buffer-file-name))))))
+
+;; Internal symbols
+
+(defun project-root-alist ()
+  "Return possibly updated cache from PROJECT-ROOT-ALIST."
+  (symbol-macrolet			;fake closures badly
+      ((project-alist    (get 'project-root-alist 'project-alist))
+       (project-internal (get 'project-root-alist 'project-internal)))
+    (if (equal project-alist project-root-alist)
+      project-internal
+      (setq project-internal
+	(sort* (loop for (name . dir)
+		     in (setq project-alist project-root-alist)
+		     collect (cons name (file-name-as-directory
+					 (file-truename dir))))
+	      (lambda (f1 f2)
+		(or (> (length f1) (length f2))
+		    (string< f1 f1)))
+	      :key #'cdr)))))
+
+(defun project-buffer-name (filename)
+  "Return the name of a buffer based on FILENAME and current projects.
+If the file is under a project hierarchy, as determined by the variable
+PROJECT-ROOT-ALIST, prefix its project-relative name with the name of the
+project.  Otherwise, name the buffer like the filename, but limit the
+directory to PROJECT-BUFFER-NAME-DIRECTORY-LIMIT characters by chopping
+off from the front and prepending PROJECT-BUFFER-NAME-DIRECTORY-PREFIX."
+  (block name
+    (let* ((truename (file-truename (if (file-directory-p filename)
+                                        (file-name-as-directory filename)
+				      filename))))
+      (loop for (name . dir) in (project-root-alist)
+	    when (and (>= (length truename) (length dir))
+		      (string= dir (substring truename 0 (length dir))))
+	    do (return-from name
+		 (concat name ":" (substring truename (length dir)))))
+      (cond
+       ((not project-rename-all-buffers)
+        (let ((lastname (file-name-nondirectory filename)))
+          (if (string= lastname "")
+              (setq lastname filename))
+          lastname))
+       (t
+        ;; Old behaviour
+        ;; may not need to abbreviate if directory is short enough
+        (when (<= (position ?/ (abbreviate-file-name truename) :from-end t)
+                  project-buffer-name-directory-limit)
+          (return-from name (abbreviate-file-name truename)))
+        ;; keep directories shorter than PROJECT-BUFFER-NAME-DIRECTORY-LIMIT.
+        ;; prepend PROJECT-BUFFER-NAME-DIRECTORY-PREFIX to abbreviated names.
+        (let* ((final (position ?/ truename :from-end t))
+               (start (- final project-buffer-name-directory-limit))
+               (first (or (position ?/ truename :start start :end final)
+                          (position ?/ truename :end start :from-end t)
+                          start)))
+          (concat project-buffer-name-directory-prefix
+                  (subseq truename first))))))))
+
+;; This overrides a function in EMACS:lisp/files.el
+
+(defun create-file-buffer (filename)
+  "Create a suitably named buffer for visiting FILENAME, and return it.
+See PROJECT-BUFFER-NAME for more information."
+  (generate-new-buffer (project-buffer-name filename)))
+
+;;; projects.el ends here
diff --git a/elisp/emacs-goodies-el/protbuf.el b/elisp/emacs-goodies-el/protbuf.el
new file mode 100755
index 0000000..92eab3c
--- /dev/null
+++ b/elisp/emacs-goodies-el/protbuf.el
@@ -0,0 +1,175 @@
+;;; protbuf.el --- protect buffers from accidental killing
+
+;; Copyright (C) 1994, 1999 Noah S. Friedman
+
+;; Author: Noah Friedman 
+;; Maintainer: friedman@splode.com
+;; Keywords: extensions
+;; Status: Works with emacs 19.23 or later.
+;; Created: 1994-06-21
+
+;; $Id: protbuf.el,v 1.2 2013/12/04 22:32:10 psg Exp $
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, you can either send email to this
+;; program's maintainer or write to: The Free Software Foundation,
+;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This package allows you to make it harder to kill buffers accidentally,
+;; e.g. by being too trigger happy selecting items in the buffer menu.
+;; protect-process-buffer-from-kill-mode is perhaps the more useful of the
+;; two, making it harder to accidentally kill shell buffers without
+;; terminating the process in them first.
+
+;;; Code:
+
+(defvar protect-buffer-verbose t
+  "*If non-nil, print a message when attempting to kill a protected buffer.")
+
+(defvar protect-buffer-bury-p t
+  "*If non-nil, bury buffer when attempting to kill it.
+This only has an effect if the buffer to be killed is the one
+visible in the selected window.")
+
+
+;;;###autoload
+(defvar protect-buffer-from-kill-mode nil
+  "*If non-`nil', then prevent buffer from being accidentally killed.
+This variable is local to all buffers.")
+(progn
+  (make-variable-buffer-local 'protect-buffer-from-kill-mode)
+  (put 'protect-buffer-from-kill-mode 'permanent-local t)
+  (or (assq 'protect-buffer-from-kill-mode minor-mode-alist)
+      (setq minor-mode-alist (cons '(protect-buffer-from-kill-mode " ProtBuf")
+                                   minor-mode-alist))))
+
+;;;###autoload
+(defvar protect-process-buffer-from-kill-mode nil
+  "*If non-`nil', then protect buffer with live process from being killed.
+This variable is local to all buffers.")
+(progn
+  (make-variable-buffer-local 'protect-process-buffer-from-kill-mode)
+  (put 'protect-process-buffer-from-kill-mode 'permanent-local t)
+  (or (assq 'protect-process-buffer-from-kill-mode minor-mode-alist)
+      (setq minor-mode-alist
+            (cons '(protect-process-buffer-from-kill-mode " ProtProcBuf")
+                  minor-mode-alist))))
+
+;;;###autoload
+(defvar protect-process-buffer-from-kill-preserve-function nil
+  "*Function to run to determine whether to kill a process buffer.
+If function returns non-nil, buffer is preserved.  Otherwise, the buffer
+may be killed.
+
+If this variable is undefined, default action is to test whether a process
+object is using this buffer as a process buffer.
+
+This variable is buffer-local when set.")
+(make-variable-buffer-local 'protect-process-buffer-from-kill-preserve-function)
+(put 'protect-process-buffer-from-kill-preserve-function 'permanent-local t)
+
+
+
+;;;###autoload
+(defun protect-buffer-from-kill-mode (&optional prefix buffer)
+  "Protect buffer from being killed.
+To remove this protection, call this command with a negative prefix argument."
+  (interactive "P")
+  (or buffer (setq buffer (current-buffer)))
+  (save-excursion
+    ;; Each cond does its own set-buffer *after* comparing prefix just in
+    ;; case there's a buffer-local variable `prefix' to screw up the works.
+    (cond
+     ((null prefix)
+      (set-buffer buffer)
+      (setq protect-buffer-from-kill-mode
+            (not protect-buffer-from-kill-mode)))
+     ((>= prefix 0)
+      (set-buffer buffer)
+      (setq protect-buffer-from-kill-mode t))
+     (t
+      (set-buffer buffer)
+      (setq protect-buffer-from-kill-mode nil)))
+    ;; This is always done because kill-buffer-query-functions might have
+    ;; been buffer-local when this package was initially loaded, leaving
+    ;; the global value unchanged.
+    (add-hook 'kill-buffer-query-functions 'protect-buffer-from-kill)))
+
+;; This function is listed in kill-buffer-query-functions; it should return
+;; nil if the buffer should not be killed, t otherwise.
+(defun protect-buffer-from-kill ()
+  (cond
+   (protect-buffer-from-kill-mode
+    (and protect-buffer-verbose
+         (message "Buffer \"%s\" is protected from being killed."
+                  (buffer-name)))
+    (and protect-buffer-bury-p
+         (eq (current-buffer)
+             (window-buffer (selected-window)))
+         (bury-buffer))
+    nil)
+   (t)))
+
+
+;;;###autoload
+(defun protect-process-buffer-from-kill-mode (&optional prefix buffer)
+  "Protect buffer from being killed as long as it has an active process.
+To remove this protection, call this command with a negative prefix argument."
+  (interactive "P")
+  (or buffer (setq buffer (current-buffer)))
+  (save-excursion
+    ;; Each cond does its own set-buffer *after* comparing prefix just in
+    ;; case there's a buffer-local variable `prefix' to screw up the works.
+    (cond
+     ((null prefix)
+      (set-buffer buffer)
+      (setq protect-process-buffer-from-kill-mode
+            (not protect-process-buffer-from-kill-mode)))
+     ((>= prefix 0)
+      (set-buffer buffer)
+      (setq protect-process-buffer-from-kill-mode t))
+     (t
+      (set-buffer buffer)
+      (setq protect-process-buffer-from-kill-mode nil)))
+    ;; This is always done because kill-buffer-query-functions might have
+    ;; been buffer-local when this package was initially loaded, leaving
+    ;; the global value unchanged.
+    (add-hook 'kill-buffer-query-functions 'protect-process-buffer-from-kill)))
+
+;; This function is listed in kill-buffer-query-functions; it should return
+;; nil if the buffer should be protected, t if buffer should be killed.
+(defun protect-process-buffer-from-kill ()
+  (cond
+   ((not protect-process-buffer-from-kill-mode) t)
+   ((or (and (boundp 'protect-process-buffer-from-kill-preserve-function)
+             protect-process-buffer-from-kill-preserve-function
+             (funcall protect-process-buffer-from-kill-preserve-function))
+        (get-buffer-process (current-buffer)))
+    (and protect-buffer-verbose
+         (message "Buffer \"%s\" has live process; not killing."
+                  (buffer-name)))
+    (and protect-buffer-bury-p
+         (eq (current-buffer)
+             (window-buffer (selected-window)))
+         (bury-buffer))
+    nil)
+   (t t)))
+
+(add-hook 'kill-buffer-query-functions 'protect-buffer-from-kill)
+(add-hook 'kill-buffer-query-functions 'protect-process-buffer-from-kill)
+
+(provide 'protbuf)
+
+;;; protbuf.el ends here
diff --git a/elisp/emacs-goodies-el/protocols.el b/elisp/emacs-goodies-el/protocols.el
new file mode 100755
index 0000000..35de52e
--- /dev/null
+++ b/elisp/emacs-goodies-el/protocols.el
@@ -0,0 +1,166 @@
+;;; protocols.el --- Protocol database access functions.
+;; Copyright 2000-2008 by Dave Pearson 
+;; $Revision: 1.4 $
+
+;; protocols.el is free software distributed under the terms of the GNU
+;; General Public Licence, version 2 or (at your option) any later version.
+;; For details see the file COPYING.
+
+;;; Commentary:
+;;
+;; protocols.el provides a set of functions for accessing the protocol
+;; details list.
+;;
+;; The latest protocols.el is always available from:
+;;
+;;   
+
+;;; BUGS:
+;;
+;; o Large parts of this code look like large parts of the code you'll find
+;;   in services.el, this is unfortunate and makes me cringe. However, I
+;;   also wanted them to be totally independant of each other. Suggestions
+;;   of how to sweetly remedy this situation are welcome.
+
+;;; INSTALLATION:
+;;
+;; o Drop protocols.el somwehere into your `load-path'. Try your site-lisp
+;;   directory for example (you might also want to byte-compile the file).
+;;
+;; o Add the following autoload statement to your ~/.emacs file:
+;;
+;;   (autoload 'protocols-lookup      "protocols" "Perform a protocol lookup" t)
+;;   (autoload 'protocols-clear-cache "protocols" "Clear the protocols cache" t)
+
+;;; Code:
+
+;; Things we need:
+
+(eval-when-compile
+  (require 'cl))
+
+;; Attempt to handle older/other emacs.
+
+(eval-and-compile
+  
+  ;; If `line-beginning-position' isn't available provide one.
+  (unless (fboundp 'line-beginning-position)
+    (defun line-beginning-position (&optional n)
+      "Return the `point' of the beginning of the current line."
+      (save-excursion
+        (beginning-of-line n)
+        (point))))
+
+  ;; If `line-end-position' isn't available provide one.
+  (unless (fboundp 'line-end-position)
+    (defun line-end-position (&optional n)
+      "Return the `point' of the end of the current line."
+      (save-excursion
+        (end-of-line n)
+        (point)))))
+
+;; Customisable variables.
+
+(defvar protocols-file "/etc/protocols"
+  "*Name of the protocols file.")
+
+;; Non-customize variables.
+
+(defvar protocols-cache nil
+  "\"Cache\" of protocols.")
+
+(defvar protocols-name-cache nil
+  "\"Cache\" of protocol names.")
+
+;; Main code.
+
+(defsubst proto-name (proto)
+  "Return the name of protocol PROTO."
+  (car proto))
+
+(defsubst proto-number (proto)
+  "Return the number of protocol PROTO."
+  (cadr proto))
+
+(defsubst proto-aliases (proto)
+  "Return the alias list of protocol PROTO."
+  (cadr (cdr proto)))
+
+(defun protocols-line-to-list (line)
+  "Convert LINE from a string into a structured protocol list."
+  (let ((words (split-string line)))
+    (list
+     (car words)
+     (string-to-int (cadr words))
+     (loop for s in (cddr words)
+           while (not (= (aref s 0) ?#))
+           collect s))))
+
+(defun* protocols-read (&optional (file protocols-file))
+  "Read the protocol list from FILE.
+
+If FILE isn't supplied the value of `protocols-file' is used."
+  (or protocols-cache
+      (setq protocols-cache (when (file-readable-p file)
+                              (with-temp-buffer
+                                (insert-file-contents file)
+                                (setf (point) (point-min))
+                                (loop until (eobp)
+                                      do (setf (point) (line-beginning-position))
+                                      unless (or (looking-at "^[ \t]*#") (looking-at "^[ \t]*$"))
+                                      collect (protocols-line-to-list (buffer-substring (line-beginning-position) (line-end-position)))
+                                      do (forward-line)))))))
+
+(defun* protocols-find-by-name (name &optional (protocols (protocols-read)))
+  "Find the protocol whose name is NAME."
+  (assoc name protocols))
+
+(defun* protocols-find-by-number (number &optional (protocols (protocols-read)))
+  "Find the protocol whose number is NUMBER."
+  (loop for protocol in protocols
+        when (= (proto-number protocol) number) return protocol))
+
+(defun* protocols-find-by-alias (alias  &optional (protocols (protocols-read)))
+  "Find the protocol that has an alias of ALIAS."
+  (loop for protocol in protocols
+        when (member alias (proto-aliases protocol)) return protocol))
+
+;;;###autoload
+(defun protocols-lookup (search)
+  "Find a protocol and display its details."
+  (interactive (list
+                (completing-read "Protocol search: "
+                                 (or protocols-name-cache
+                                     (setq protocols-name-cache
+                                           (loop for protocol in (protocols-read)
+                                                 collect (list (proto-name protocol))
+                                                 append (loop for alias in (proto-aliases protocol)
+                                                              collect (list alias))))))))
+  (let* ((protocols (protocols-read))
+         (protocol (or (when (string-match "^[0-9]+$" search)
+                         (protocols-find-by-number (string-to-int search) protocols))
+                       (protocols-find-by-name search protocols)
+                       (protocols-find-by-name (downcase search) protocols)
+                       (protocols-find-by-name (upcase search) protocols)
+                       (protocols-find-by-alias search protocols)
+                       (protocols-find-by-alias (downcase search) protocols)
+                       (protocols-find-by-alias (upcase search) protocols))))
+    (if protocol
+        (message "Protocol: %s  ID: %d  Aliases: %s"
+                 (proto-name protocol)
+                 (proto-number protocol)
+                 (with-output-to-string
+                     (loop for alias in (proto-aliases protocol)
+                           do (princ alias) (princ " "))))
+      (error "Can't find a protocol matching \"%s\"" search))))
+
+;;;###autoload
+(defun protocols-clear-cache ()
+  "Clear the protocols \"cache\"."
+  (interactive)
+  (setq protocols-cache      nil
+        protocols-name-cache nil))
+
+(provide 'protocols)
+
+;;; protocols.el ends here.
diff --git a/elisp/emacs-goodies-el/quack.el b/elisp/emacs-goodies-el/quack.el
new file mode 100644
index 0000000..0aa0a44
--- /dev/null
+++ b/elisp/emacs-goodies-el/quack.el
@@ -0,0 +1,4820 @@
+;;; quack.el --- enhanced support for editing and running Scheme code
+
+(defconst quack-copyright    "Copyright (C) 2002-2012, 2016 Neil Van Dyke")
+(defconst quack-copyright-2  "Portions Copyright (C) Free Software Foundation")
+;; Emacs-style font-lock specs adapted from GNU Emacs 21.2 scheme.el.
+;; Scheme Mode menu adapted from GNU Emacs 21.2 cmuscheme.el.
+
+(defconst quack-version      "0.48")
+(defconst quack-author-name  "Neil Van Dyke")
+(defconst quack-author-email "neil@neilvandyke.org")
+(defconst quack-web-page     "http://www.neilvandyke.org/quack/")
+
+(defconst quack-legal-notice
+  "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.  See
+http://www.gnu.org/licenses/ for details.  For other licenses and consulting,
+please contact Neil Van Dyke.")
+
+(defconst quack-cvsid "$Id: quack.el,v 1.5 2016/11/06 19:44:39 psg Exp $")
+
+;;; Commentary:
+
+;; INTRODUCTION:
+;;
+;;     Quack enhances Emacs support for Scheme programming.
+;;
+;;     Install Quack rather than following non-Quack-based tutorials on how to
+;;     set up Emacs for Scheme.
+;;
+;;     The name "Quack" was a play on "DrScheme".
+;;
+;;     Quack is dedicated to Yosh, naturally.
+
+;; COMPATIBILITY:
+;;
+;;     GNU Emacs 23 and 22 -- Yes.  Quack is now developed under GNU Emacs 23
+;;     on a GNU/Linux system, which is the preferred platform for Quacksmokers.
+;;     Quack should work under GNU Emacs 23 on any Un*x-like OS.  Reportedly,
+;;     Quack also works with GNU Emacs 22 on Apple Mac OS X and Microsoft
+;;     Windows (NT, 2000, XP), but the author has no means of testing on those
+;;     platforms.
+;;
+;;     GNU Emacs 21 -- Probably, but no longer tested.
+;;
+;;     GNU Emacs 20 -- Probably mostly.  When last tested. Some of the menus do
+;;     not work properly, due to a bug in easymenu.el (which the FSF will not
+;;     fix, since they no longer support Emacs 20).  Nested block comments are
+;;     not fontified correctly.  Pretty-lambda does not work.  Quack runs less
+;;     efficiently in 20 than 21, due to the lack of standard hash tables.
+;;
+;;     XEmacs 21 -- Probably mostly, but no longer tested.  Block comment
+;;     fontification is not yet supported under XEmacs 21, due to what appears
+;;     to be a bug in 21.4 font-lock.  Pretty-lambda does not work.  XEmacs
+;;     Quacksmokers who always want the latest and greatest Quack should
+;;     consider GNU Emacs 21 -- Quack treats XEmacs like a high-maintenance
+;;     redheaded stepchild.
+
+;; INSTALLATION:
+;;
+;;     To install, put this file (`quack.el') somewhere in your Emacs load
+;;     path, and add the following line to your `.emacs' file:
+;;
+;;         (require 'quack)
+;;
+;;     If you don't know what your Emacs load path is, try invoking the command
+;;     "C-h v load-path RET" or consulting the Emacs manual.
+;;
+;;     Note to advanced Emacsers: Byte-compiled `quack.elc' files generally are
+;;     *not* portable between Emacs implementations, nor between different
+;;     versions of the same implementation.
+;;
+;;     You will also need the GNU `wget' program, which Quack uses for
+;;     downloading SRFI indexes.  This popular program is included in most
+;;     GNU/Linux distributions and is available for most other platforms.
+;;
+;;     Note to PLT Scheme users: If you do not already have the PLT manuals
+;;     installed, they can be downloaded from 
+;;     `http://download.plt-scheme.org/doc/' and installed in your PLT `doc'
+;;     collection.  If Quack is not finding installed PLT manuals, then be sure
+;;     that the `quack-pltcollect-dirs' variable contains the appropriate
+;;     collection directory (if it does not, then either set the `PLTHOME'
+;;     and/or `PLTCOLLECTS' environment variables appropriately, or set
+;;     `quack-pltcollect-dirs').
+
+;; KEY BINDINGS:
+;;
+;;     The key bindings that Quack adds to `scheme-mode' include:
+;;
+;;         C-c C-q m   View a manual in your Web browser.
+;;         C-c C-q k   View the manual documentation for a keyword
+;;                     (currently only works for PLT manuals).
+;;         C-c C-q s   View an SRFI.
+;;         C-c C-q r   Run an inferior Scheme process.
+;;         C-c C-q f   Find a file using context of point for default.
+;;         C-c C-q l   Toggle `lambda' syntax of `define'-like form.
+;;         C-c C-q t   Tidy the formatting of the buffer.
+;;
+;;     One additional command that does not currently have a standard binding
+;;     is `quack-dired-pltcollect', which prompts for a PLT collection name and
+;;     creates a Dired buffer on the collection's directory.  (A future version
+;;     of Quack may integrate this functionality into a more generalized
+;;     documentation navigation interface.)
+
+;; RELEASE ANNOUNCEMENTS EMAIL:
+;;
+;;     To receive email notification when a new Quack version is released, ask
+;;     neil@neilvandyke.org to add you to the moderated `scheme-announce' list.
+
+;; HISTORY:
+;;
+;;     Version 0.48 (2016-04-03):
+;;         * Made fontify `#true` and `#false`.
+;;
+;;     Version 0.47 (2012-11-15):
+;;         * Added indent for `call-with-' file variants and semaphore.
+;;         * Added font and indent for `with-handlers*', `define-runtime-path',
+;;           `match-let'.
+;;
+;;     Version 0.46 (2012-06-20):
+;;         * Added indent for `letrec-values'.
+;;         * Corrected date on history for version 0.45.
+;;
+;;     Version 0.45 (2012-06-18):
+;;         * Added a bunch of indent rules for Scribble definition forms
+;;           and Racket sequence/iterator stuff, plus Overeasy `test-section'.
+;;
+;;     Version 0.44 (2012-04-11):
+;;         * Added indent and fontify for `struct', `module+', `module*'.
+;;         * Changed intent for `module' from `defun' to 2.
+;;         * Added fontify for `define-syntax-class',
+;;           `define-splicing-syntax-class', `begin-for-syntax'.
+;;         * Changed `define-struct' fontify.
+;;
+;;     Version 0.43 (2011-08-23):
+;;         * Add indent and fontify for "syntax-parse".
+;;         * Added another compile error regexp for Racket backtraces.
+;;
+;;     Version 0.42 (2011-07-30):
+;;         * Added compile error regexp for "raco".
+;;
+;;     Version 0.41 (2011-06-04)
+;;         * Added `sxml-match' to `scheme-indent-function'.
+;;
+;;     Version 0.40 (2010-12-22)
+;;         * Added indent rules for Racket `let:', `let*:', and `match'.  And
+;;           a provisional rule for `define:'.
+;;
+;;     Version 0.39 (2010-10-18)
+;;         * Renamed "typed/scheme" to "typed/racket".
+;;
+;;     Version 0.38 (2010-10-14)
+;;         * Replaced old PLT Scheme programs in `quack-programs' with Racket.
+;;         * Added Racket ".rkt" and ".rktd" filename extensions.
+;;         * Added some Racket keywords for fontifying.
+;;
+;;     Version 0.37 (2009-06-29)
+;;         * Disabled highlighting of "Compilation started at" lines.
+;;
+;;     Version 0.36 (2009-05-27)
+;;         * Made `#:' ``colon keywords'' fontify in PLT-ish mode.
+;;         * Added PLT `r6rs' and `typed-scheme' languages to `quack-programs'.
+;;
+;;     Version 0.35 (2009-02-24)
+;;         * Added `interpreter-mode-alist' support, so Scheme scripts with "#!"
+;;           start in `scheme-mode'.
+;;         * Added PLT `parameterize-break'.
+;;         * Improved `compile' mode for PLT 4.x tracebacks when there is only
+;;           file, line, and column, but no additional information.
+;;
+;;     Version 0.34 (2009-02-19)
+;;         * Added fontify and indent support for PLT `define/kw', `lambda/kw',
+;;          `parameterize*'.
+;;         * Fontify Unix "#!" cookie in PLT-ish font-lock.
+;;         * Changed reference to `quack-announce' email list to
+;;           `scheme-announce'.
+;;         * Added PLT `default-load-handler' to
+;;          `quack-compilation-error-regexp-alist-additions'
+;;         * Changed some face ":height" attributes.
+;;
+;;     Version 0.33 (2008-07-31)
+;;         * Added handlers for some PLT 4.0.1 "setup-plt" messages.
+;;
+;;     Version 0.32 (2008-06-19)
+;;         * Added to `quack-programs'.
+;;         * Updated compatibility comments.
+;;         * Added indent rule for `for/fold'.
+;;
+;;     Version 0.31 (2008-05-03)
+;;         * Added `defvar' for `quack-pltish-font-lock-keywords', so that the
+;;           GNU Emacs 22.1 compiler doesn't complain about assignment to a free
+;;           variable.
+;;         * Changed banner regexp for MzScheme for v3.99.x.
+;;         * Set `dynamic-wind' `scheme-indent-function to 0, when the default
+;;           is 3.  It was just taking up too much space.  DrScheme's
+;;           indentation seems to be equivalent -1, so there is precedent for
+;;           something different.  We generally respect Emacs indentation
+;;           convention.
+;;         * Added fontifying and indent for PLT `define-for-syntax',
+;;           `define-values-for-syntax', `quasisyntax', `quasisyntax/loc',
+;;           `syntax', `syntax/loc', `define-parameters'.
+;;         * Advise `scheme-interactively-start-process' for GNU Emacs 22.
+;;         * Removed TODO comment that mentioned using `(current-eventspace
+;;           (make-eventspace))' under `mred', as Robby Findler has indicated
+;;           that is not good advice.
+;;
+;;     Version 0.30 (2007-06-27)
+;;         * Emacs 22 compatibility change: `string-to-number' instead of
+;;           `string-to-int'.  Thanks to Charles Comstock.
+;;
+;;     Version 0.29 (2006-11-12)
+;;         * Fixed `quack-bar-syntax-string', which caused vertical bar
+;;           characters to be treated as whitespace.  Thanks to Eric Hanchrow
+;;           for reporting.
+;;
+;;     Version 0.28 (2005-05-14)
+;;         * Added `quack-smart-open-paren-p'.
+;;         * Changed `scheme-indent-function' for `parameterize' from `defun'
+;;           to `1'.
+;;         * In `quack-pltish-keywords-to-fontify': added `quasiquote',
+;;           `unquote', and `unquote-splicing'.
+;;         * Added ".mzschemerc" to `auto-mode-alist'.
+;;         * Added a little extra threesemi fontification for Funcelit and
+;;           similar Texinfo markup formats.
+;;
+;;     Version 0.27 (2004-12-19)
+;;         * For Gambit-C, added REPL banner fontifying, `quack-manuals' entry,
+;;           and "gsi ~~/syntax-case.scm -" `quack-programs' entry.
+;;         * Changed "[PLT]" prefix on PLT manuals to "PLT", to make it easier
+;;           to type.
+;;         * Minor changes to reflect "MIT Scheme" becoming "MIT/GNU Scheme".
+;;
+;;     Version 0.26 (2004-07-14)
+;;         * Added fontifying of a bunch of "define-"* syntax from Chicken.
+;;
+;;     Version 0.25 (2004-07-09)
+;;         * Added `define-record-type' to `quack-pltish-keywords-to-fontify'.
+;;         * Added "csi -hygienic" to `quack-programs'.
+;;         * In `quack-manuals', replaced PLT-specific `r5rs' and `t-y-scheme'
+;;           with generic ones.
+;;         * Updated URL in `quack-manuals' for 3rd ed. of `tspl'.
+;;         * `quack-view-manual' completions no longer include symbols.
+;;         * `quack-view-manual' completion default is now "R5RS".
+;;
+;;     Version 0.24 (2004-05-09)
+;;         * Made `quack-pltish-keywords-to-fontify' and
+;;           `quack-emacs-keywords-to-fontify' custom changes update
+;;           immediately.  Bug reported by Taylor Campbell.
+;;         * Removed some non-syntax names from  
+;;           `quack-pltish-keywords-to-fontify'.
+;;         * Documentation changes.
+;;
+;;     Version 0.23 (2003-11-11)
+;;         * `quack-local-keywords-for-remote-manuals-p' can now have the value
+;;           of the symbol `always', to work around a defect in some versions
+;;           of Microsoft Windows.  Thanks to Bill Clementson.
+;;         * `quack-w3m-browse-url-other-window' no longer splits a `*w3m*'
+;;           buffer.
+;;         * Added indent and `quack-pltish-keywords-to-fontify' rules for
+;;           `c-lambda' and `c-declare'.
+;;
+;;     Version 0.22 (2003-07-03)
+;;         * `quack-newline-behavior' controls the RET key behavior in Scheme
+;;           buffers.
+;;         * In `quack-manuals', added Chez Scheme, and updated Chicken.
+;;         * Added error message navigation to `compile' for PLT `setup-plt'.
+;;         * Partial fix for Quack global menu disappearing from the main menu
+;;           bar in XEmacs.  Thought it used to work, but it doesn't in XEmacs
+;;           21.4.12.
+;;
+;;     Version 0.21 (2003-05-28)
+;;         * `quack-find-file' is faster in many cases due to fix to
+;;           `quack-backward-sexp'.
+;;         * Added auto-mode-alist for `.ccl', `.stk', and `.stklos' files.
+;;         * Indent rule additions/changes for `chicken-setup' and `unit/sig'.
+;;
+;;     Version 0.20 (2003-05-04)
+;;         * Added indent and fontify for SRFI-8 "receive".
+;;         * Added indent and fontify for additional PLT syntax.
+;;         * Added `quack-fontify-threesemi-p'.
+;;         * `quack-tidy-buffer' sets `fill-prefix' to nil when running.
+;;         * Added messages to `run-scheme', if only to get rid of annoying 
+;;           "Mark set" message.
+;;         * Added "mzscheme -M errortrace" to `quack-programs'.
+;;         * `quack-dired-pltcollect' prompt defaults to `mzlib'.
+;;         * "Update SRFI Index" menu item has moved to top of menu, mainly to
+;;           avoid usability issue in a particular Emacs menu implementation.
+;;         * Several code quality improvements sent by Stefan Monnier will be
+;;           in the next release.
+;;
+;;     Version 0.19 (2003-03-04)
+;;         * Commands such as `scheme-load-file' now start a Scheme process if
+;;           none is found.
+;;         * Bugfix for using `match-string-no-properties' when we meant
+;;           `quack-match-string-no-properties'.  (Thanks to Noel Welsh.)
+;;
+;;     Version 0.18 (2003-05-02)
+;;         * Removed uses of `(regexp-opt LIST t)', since XEmacs21 does not
+;;           create match data.  (Thanks to Garrett Mitchener for debugging.)
+;;         * Added to `quack-programs' and `quack-manuals'.
+;;         * Added pretty-case-lambda.
+;;         * Changed PLT documentation URL function.
+;;
+;;     Version 0.17 (2003-01-03)
+;;         * Pretty-lambda is supported well under GNU Emacs 21, when using PLT
+;;           Style fontification.  Enable via the Options menu.  (Based on
+;;           approach by Stefan Monnier; suggested by Ray Racine.)
+;;         * Various faces now have separate defaults for `light' and `dark'
+;;           backgrounds, so may now look better on dark backgrounds.
+;;           (Suggested by Eli Barzilay.)
+;;         * `quack-find-file' now respects `insert-default-directory' when
+;;           there is no default file.  (Thanks to Eli Barzilay.)
+;;         * Most of the special w3m support has been moved to a separate
+;;           package, `w3mnav' (`http://www.neilvandyke.org/w3mnav/').
+;;           `quack-w3m-browse-url-other-window' has been added.
+;;
+;;     Version 0.16 (2002-12-16)
+;;         * `quack-insert-closing' now calls `blink-paren-function'.  (Thanks
+;;           to Guillaume Marceau and Steve Elkins for reporting this.)
+;;         * Now uses PLT 202 manuals.  Added "PLT Framework" manual.
+;;         * Added `quack-pltish-module-defn-face'.
+;;         * Added some PLTish font-lock keywords.
+;;
+;;     Version 0.15 (2002-11-21)
+;;         * "Keywords" are now fontified in PLT Style fontification mode.
+;;         * Definition names are now blue by default in PLT Style.
+;;         * Symbol literals with vertical bars are now fontified in PLT Style.
+;;         * New `quack-manuals-webjump-sites' function for people who prefer
+;;           to use the `webjump' package for invoking manuals.
+;;         * New `quack-quiet-warnings-p' option.
+;;         * New `quack-pltish-class-defn-face' face.
+;;
+;;     Version 0.14 (2002-10-18)
+;;         * Fix for `quack-view-manual' interactive prompting (thanks to Marko
+;;           Slyz for reporting this).
+;;         * `quack-emacsw3m-go-next' and `quack-emacsw3m-go-prev' now work
+;;           with GTK reference documentation (not that this has anything to do
+;;           with Scheme).
+;;         * Added SLIB to `quack-manuals'.
+;;         * Added comment about installing PLT manuals (thanks to Marko).
+;;         * We now call the canonical version of Emacs "GNU Emacs," instead of
+;;           "FSF Emacs".
+;;
+;;     Version 0.13 (2002-09-21)
+;;         * Bugfix: No longer drop SRFI index entries on the floor.
+;;
+;;     Version 0.12 (2002-09-20)
+;;         * New "View SRFI" menu.  Select "Update SRFI Index" if the submenus
+;;           "Draft", "Final", and "Withdrawn" are disabled.
+;;         * Most options are now settable via "Options" menu.
+;;         * PLT collections are no longer scanned when building "View Manuals"
+;;           menu.
+;;         * "View Keyword Docs..." back on Scheme Mode menu in addition to
+;;           Quack menu.
+;;         * Various `defcustom' variables have been made to dynamically update
+;;           relevant program state when changed.
+;;         * Under GNU Emacs 20, dynamic menus still do not work -- they now
+;;           display, but do not perform the selected action.  Will do more
+;;           debugging after this release.
+;;         * '[' and ']' keys work in emacs-w3m of MIT Scheme manuals.
+;;
+;;     Version 0.11 (2002-09-17)
+;;         * Menus now work under XEmacs.  Also now partly broken for Emacs 20.
+;;         * New global "Quack" menu.  Disable with `quack-global-menu-p'.
+;;         * New "View Manual" submenu under GNU Emacs 21 and XEmacs (GNU Emacs
+;;           20 is stuck with the old "View Manual..." menu item).
+;;         * Fix for `quack-pltcollects-alist' to include PLT `doc' collection,
+;;           which was preventing local manuals from being used.
+;;         * `quack-manuals' now includes `t-y-scheme'.
+;;         * `quack-view-in-different-browser' command that spawns alternative
+;;           Web browser from the special emacs-w3m support, bound to `B'.  For
+;;           when you normally view manuals in an Emacs window, but
+;;           occasionally want to view a particular page in normal Web browser.
+;;         * More `scheme-indent-function' properties set.
+;;         * `quack-about' command.
+;;         * Fix to `quack-keyword-at-point'.
+;;
+;;     Version 0.10 (2002-09-11)
+;;         * `quack-view-srfi' now prompts with completion, including titles
+;;           for all SRFIs.  The SRFI titles are fetched from the official SRFI
+;;           Web site using the GNU Wget program, and cached locally.
+;;         * `quack-view-srfi' also now defaults to the SRFI number at or near
+;;           the point.
+;;         * `quack-dir' variable specifies a directory where Quack should
+;;           store its persistent data files (e.g., cached SRFI indexes), and
+;;           defaults to "~/.quack/".
+;;         * New `quack-tidy-buffer' command.  [C-c C-q t] is now bound to
+;;           this; [C-c C-q l] ("l" as in "lambda) is now the official binding
+;;           for `quack-toggle-lambda'.
+;;         * `quack-find-file' now recognizes PLT `dynamic-require' form.
+;;         * Fix to make `quack-looking-at-backward' preserve match data.
+;;         * Fix for benign bug in `quack-parent-sexp-search'.
+;;
+;;     Version 0.9 (2002-09-04)
+;;         * Quack now works under XEmacs 21, except no menus are currently
+;;           defined (that will come in a later version) and block comments
+;;           aren't fontified.
+;;         * `quack-toggle-lambda' command toggles a `define' form between
+;;           explicit and implicit `lambda' syntax.
+;;         * `quack-dired-pltcollect' feature prompts for a PLT collection name
+;;           and creates a Dired on the collection.
+;;         * `)' and `]' keys are bound to insert a closing character that
+;;           agrees with the opening character of the sexp.
+;;         * Nested `#|' comment blocks are now fontified mostly correctly
+;;           under GNU Emacs 21.
+;;         * Fix to `quack-parent-sexp-search'.
+;;         * Fix for PLT manual keywords lookup under Emacs 20.
+;;         * `quack-manuals' URLs for assorted implementation manuals now point
+;;           to canonical Web copies.
+;;         * No longer warns about PLT manual keywords file found without HTML.
+;;         * `find-file' key bindings are automatically remapped to
+;;           `quack-find-file' in Scheme buffers.
+;;         * Both PLT-style and Emacs-style fontification now work with the
+;;           `noweb-mode' package.  Tested under GNU Emacs 21 with
+;;           Debian `nowebm' package version 2.10c-1.
+;;         * Added to `quack-emacsish-keywords-to-fontify'.
+;;         * Disabled fontification of named `let'.
+;;         * Renamed "collect" in PLT identifiers to "pltcollect".
+;;         * `auto-mode-alist' set more aggressively.
+;;
+;;     Version 0.8 (2002-08-25)
+;;         * PLT package file viewing mode.  This is mainly used to easily
+;;           inspect a ".plt" package before installing it via DrScheme or
+;;           "setup-plt".
+;;         * No longer warns about `font-lock-keywords' when `noweb-mode'
+;;           package is installed.
+;;
+;;     Version 0.7 (2002-08-22)
+;;         * Now works on GNU Emacs 20 (though people are still encouraged to
+;;           upgrade to GNU Emacs 21 if they are able).
+;;         * `quack-manuals' now includes MIT Scheme and Chicken manuals
+;;           (currently where Debian GNU/Linux puts them).
+;;         * `quack-view-srfi' command.
+;;         * Named-`let' name is fontified like a PLTish definition name.
+;;         * `define-record' and `define-opt' fontified.
+;;         * Scheme Mode is forced in `auto-mode-alist' for ".sch" files.
+;;         * Fix to `quack-backward-sexp'.
+;;         * `quack-warning' messages get your attention.
+;;         * `quack-pltrequire-at-point-data-1' search depth limited.
+;;
+;;     Version 0.6 (2002-08-20)
+;;         * `quack-find-file' now supports multi-line PLT `require' forms.
+;;         * When `emacs-w3m' is used, the keys "[", "]", and "t" are bound to
+;;           navigate through PLT manuals like in Info mode.
+;;         * Names highlighted in PLT-style fontification of `defmacro',
+;;           `defmacro-public', `defsyntax'.
+;;         * Advised `run-scheme' no longer prompts when there is already a
+;;           running Scheme.
+;;         * "csi" (Chicken interpreter) added to `quack-programs' default.
+;;         * Forces `auto-mode-alist' for ".scm" files to `scheme-mode'
+;;           (two can play at that game, `bee-mode'!).
+;;         * To-do comments moved from the top of the file to throughout code.
+;;
+;;     Version 0.5 (2002-08-15)
+;;         * New `quack-find-file' permits quick navigation to files indicated
+;;           by a PLT Scheme `require' form under the point.  Currently only
+;;           works when the "(require" string is on the same line as point.
+;;         * Improved PLT-style fontification.  Most noticeable difference is
+;;           that names in many definition forms are boldfaced.  See
+;;           `quack-pltish-fontify-definition-names-p' option.
+;;         * `quack-collects-alist' added.
+;;         * "~/plt/" has been removed from `quack-collect-dirs' default.
+;;         * Unnecessary syntax table settings have been removed.
+;;         * Reduced memory usage in some cases, via explicit GC calls.
+;;
+;;     Version 0.4 (2002-08-07)
+;;         * Functionality adapted from author's `giguile.el' package:
+;;             - Enhanced `run-scheme' behavior.  `quack-run-mzscheme',
+;;               `quack-run-mred', and `quack-remove-run-scheme-menu-item-p'
+;;               are obsolete.
+;;             - Enhanced `switch-to-scheme' behavior.
+;;             - Options menu.
+;;             - Indent rules for a few Guile-isms.
+;;         * Inferior Scheme Mode now uses the preferred fontification method.
+;;         * Now uses the PLT-bundled version of R5RS manual, which permits
+;;           keyword searching.
+;;         * `quack-banner-face' for the MzScheme/MrEd banner in REPL buffer.
+;;         * This code includes a start on toolbars and XEmacs21 portability,
+;;           but neither feature is yet functional.
+;;
+;;     Version 0.3 (2002-08-01)
+;;         * PLT-style fontification added, except for quoted lists.  Emacs-
+;;           style fontification still available; see `quack-fontify-style'.
+;;         * `emacs-w3m' package support for lightweight viewing of PLT manuals
+;;           in Emacs window.  If you install the `emacs-w3m' package, then you
+;;           can change the new `quack-browse-url-browser-function' option to
+;;           use it.
+;;         * Quack menu items added to Scheme Mode menu.  "Run Scheme" item
+;;           is removed by default; see `quack-remove-run-scheme-menu-item-p'.
+;;         * MrEd REPL supported with `quack-run-mred'.
+;;         * Better default for `quack-collect-dirs'.
+;;         * More `scheme-indent-function' settings.
+;;         * Bugfix for `quack-prompt-for-kwmatch-choice'.
+;;         * Bugfix for font-lock keywords getting set too early.
+;;         * Now byte-compiles without warnings/errors.
+;;
+;;     Version 0.2 (2002-07-28)
+;;         * Manual keywords lookup.
+;;         * Other minor changes.
+;;
+;;     Version 0.1 (2002-07-18)
+;;         * Initial release.
+
+;; ADMONISHMENT TO IMPRESSIONABLE YOUNG SCHEME STUDENTS:
+;;
+;;     Quack should by no means be construed as a model of good programming,
+;;     much less of good software engineering.  Emacs is by nature a complex
+;;     system of interacting kludges.  To get Emacs to do useful new things is
+;;     to artfully weave one's extensions into a rich tapestry of sticky duct
+;;     tape.  Also, Quack usually only got hacked on when I was stuck in a busy
+;;     lobby for an hour with a laptop and unable to do real work.
+
+;;; Code:
+
+;; Dependencies:
+
+(require 'advice)
+(require 'cmuscheme)
+(require 'compile)
+(require 'custom)
+(require 'easymenu)
+(require 'font-lock)
+(require 'scheme)
+(require 'thingatpt)
+
+(unless (fboundp 'customize-save-variable)
+  (autoload 'customize-save-variable "cus-edit"))
+
+;; Custom Variables:
+
+(defgroup quack nil
+  "Enhanced support for editing and running Scheme code."
+  :group  'scheme
+  :prefix "quack-"
+  :link   '(url-link "http://www.neilvandyke.org/quack/"))
+
+(defcustom quack-dir "~/.quack"
+  "*Directory where Quack stores various persistent data in file format."
+  :type  'string
+  :group 'quack)
+
+(defcustom quack-scheme-mode-keymap-prefix "\C-c\C-q"
+  "*Keymap prefix string for `quack-scheme-mode-keymap'.
+
+One of the nice things about having C-q in the prefix is that it is unlikely to
+be already be in use, due to the historical reality of software flow control
+\(and the fact that it is hard to type).  If your C-q doesn't seem to be going
+through, then you have several options: disable flow control (if it is safe to
+do so), change the value of this variable, or see the Emacs documentation for
+`enable-flow-control-on'."
+  :type  'string
+  :group 'quack)
+
+(defcustom quack-remap-find-file-bindings-p t
+  "Whether to remap `find-file' key bindings to `quack-find-file'.
+The local map in Scheme Mode and Inferior Scheme Mode buffers is used."
+  :type  'boolean
+  :group 'quack)
+
+(defcustom quack-global-menu-p t
+  "*Whether to have a \"Quack\" menu always on the menu bar."
+  :type  'boolean  :group 'quack)
+
+(defcustom quack-tabs-are-evil-p t
+  "*Whether Quack should avoid use of Tab characters in indentation."
+  :type  'boolean
+  :group 'quack)
+
+(defcustom quack-browse-url-browser-function nil
+  "*Optional override for `browse-url-browser-function'.
+
+If non-nil, overrides that variable for URLs viewed by `quack-browse-url'."
+  :type '(choice (const    :tag "Do Not Override" nil)
+                 (function :tag "Function")
+                 (alist    :tag "Regexp/Function Association List"
+                           :key-type regexp :value-type function))
+  :group 'quack)
+
+(defcustom quack-manuals                ; TODO: Options menu.
+
+  ;; TODO: If we make this so users are likely to want to override parts of it,
+  ;;       then introduce `quack-manuals-defaults' variable with this in it,
+  ;;       and let users edit `quack-manuals-overrides' which are keyed on the
+  ;;       ID symbol.
+
+  ;; TODO: Have a way for finding docs on the local filesystem, and/or
+  ;;       permitting a user to easily specify location.
+
+  ;; TODO: Provide a way of specifying alternative access means so that, for
+  ;;       example, we can look for R5RS first in locally-installed PLT
+  ;;       collection, then in one of various non-PLT directories it might be
+  ;;       mirrored, then remote PLT copy using local PLT keywords file, then
+  ;;       the canonical HTML copy on the Web...  Maybe even permit Info
+  ;;       format.  Let's just reinvent the Web, while we're at it.
+
+  '(
+
+    (r5rs "R5RS"
+          "http://www.schemers.org/Documents/Standards/R5RS/HTML/"
+          nil)
+
+    (bigloo
+     "Bigloo"
+     "http://www-sop.inria.fr/mimosa/fp/Bigloo/doc/bigloo.html"
+     ;;"file:///usr/share/doc/bigloo/manuals/bigloo.html"
+     nil)
+
+    (chez
+     "Chez Scheme User's Guide"
+     "http://www.scheme.com/csug/index.html"
+     nil)
+
+    (chicken
+     "Chicken User's Manual"
+     "http://www.call-with-current-continuation.org/manual/manual.html"
+     ;;"file:///usr/share/doc/chicken/manual.html"
+     nil)
+
+    (gambit
+     "Gambit-C home page"
+     "http://www.iro.umontreal.ca/~gambit/")
+
+    (gauche
+     "Gauche Reference Manual"
+     "http://www.shiro.dreamhost.com/scheme/gauche/man/gauche-refe.html"
+     nil)
+
+    (mitgnu-ref
+     "MIT/GNU Scheme Reference"
+     "http://www.gnu.org/software/mit-scheme/documentation/scheme.html"
+     ;;"http://www.swiss.ai.mit.edu/projects/scheme/documentation/scheme.html"
+
+     ;;"file:///usr/share/doc/mit-scheme/html/scheme.html"
+     nil)
+
+    (mitgnu-user
+     "MIT/GNU Scheme User's Manual"
+     "http://www.gnu.org/software/mit-scheme/documentation/user.html"
+     ;;"http://www.swiss.ai.mit.edu/projects/scheme/documentation/user.html"
+     ;;"file:///usr/share/doc/mit-scheme/html/user.html"
+     nil)
+
+    (mitgnu-sos
+     "MIT/GNU Scheme SOS Reference Manual"
+     "http://www.gnu.org/software/mit-scheme/documentation/sos.html"
+     ;;"http://www.swiss.ai.mit.edu/projects/scheme/documentation/sos.html"
+     ;;"file:///usr/share/doc/mit-scheme/html/sos.html"
+     nil)
+
+    (plt-mzscheme  "PLT MzScheme: Language Manual"                plt t)
+    (plt-mzlib     "PLT MzLib: Libraries Manual"                  plt t)
+    (plt-mred      "PLT MrEd: Graphical Toolbox Manual"           plt t)
+    (plt-framework "PLT Framework: GUI Application Framework"     plt t)
+    (plt-drscheme  "PLT DrScheme: Programming Environment Manual" plt nil)
+    (plt-insidemz  "PLT Inside PLT MzScheme"                      plt nil)
+    (plt-tools     "PLT Tools: DrScheme Extension Manual"         plt nil)
+    (plt-mzc       "PLT mzc: MzScheme Compiler Manual"            plt t)
+    (plt-r5rs      "PLT R5RS"                                     plt t)
+
+    (scsh
+     "Scsh Reference Manual"
+     "http://www.scsh.net/docu/html/man-Z-H-1.html"
+     ;;"file:///usr/share/doc/scsh-doc/scsh-manual/man-Z-H-1.html"
+     nil)
+
+    (sisc
+     "SISC for Seasoned Schemers"
+     "http://sisc.sourceforge.net/manual/html/"
+     nil)
+
+    (htdp       "How to Design Programs"
+                "http://www.htdp.org/"
+                nil)
+    (htus       "How to Use Scheme"
+                "http://www.htus.org/"
+                nil)
+    (t-y-scheme "Teach Yourself Scheme in Fixnum Days"
+                "http://www.ccs.neu.edu/home/dorai/t-y-scheme/t-y-scheme.html"
+                nil)
+    (tspl       "Scheme Programming Language (Dybvig)"
+                "http://www.scheme.com/tspl/"
+                nil)
+    (sicp       "Structure and Interpretation of Computer Programs"
+                "http://mitpress.mit.edu/sicp/full-text/book/book-Z-H-4.html"
+                nil)
+    (slib       "SLIB"
+                "http://swissnet.ai.mit.edu/~jaffer/SLIB.html"
+                nil)
+    (faq        "Scheme Frequently Asked Questions"
+                "http://www.schemers.org/Documents/FAQ/"
+                nil))
+  "*List of specifications of manuals that can be viewed.
+
+Each manual specification is a list of four elements:
+
+    (SYMBOL TITLE LOCATION USE-KEYWORDS-P)
+
+where SYMBOL is a short symbol that identifies the manual, TITLE is a string,
+LOCATION is either a string with the URL of the manual or the symbol `plt',
+and USE-KEYWORDS-P is `t' or `nil'.
+
+If LOCATION is `plt', then Quack treats it as a PLT bundled manual, looking for
+the HTML and keyword files in `quack-pltcollect-dirs', and optionally providing
+keyword lookup if USE-KEYWORDS-P is `t'.  Remote canonical copies of the
+manuals will be used if local copies cannot be found.
+
+If LOCATION is a URL, then USE-KEYWORDS-P must be `nil'."
+  :type  '(repeat (list (symbol :tag "Identifying Symbol")
+                        (string :tag "Title String")
+                        (choice :tag "Location"
+                                (string :tag "URL")
+                                (const  :tag "PLT Bundled Manual" plt))
+                        (boolean :tag "Use Keywords?")))
+  :group 'quack)
+
+(defcustom quack-local-keywords-for-remote-manuals-p t
+  "*If non-nil, Quack will use canonical remote Web URLs when there is a local
+keyword file for a PLT manual but no local HTML files.  (This feature was
+prompted by the Debian 200.2-3 package for MzScheme, which includes keyword
+files but not HTML files.)  If the symbol `always', then Quack will always use
+remote Web manuals for keywords lookup, even if local HTML files exist, as a
+workaround for how some versions of Emacs interact with some versions of
+Microsoft Windows \(inexplicably discarding the fragment identifier from `file'
+scheme URI\)."
+  :type       '(choice (const :tag "Permit"    t)
+                       (const :tag "Forbid"     nil)
+                       (const :tag "Always" always))
+  :group      'quack
+  :set        'quack-custom-set
+  :initialize 'custom-initialize-default)
+
+(defcustom quack-srfi-master-base-url "http://srfi.schemers.org/"
+  ;; Note: Intentionally not letting user change this through the options menu.
+  "*The base URL for the master SRFI Web pages.
+The SRFI index files should be immediately beneath this."
+  :type   'string
+  :group  'quack)
+
+(defcustom quack-pltcollect-dirs
+  (let ((good '()))
+    (mapcar (function (lambda (dir)
+                        (and dir
+                             (not (assoc dir good))
+                             (file-directory-p dir)
+                             (setq good (nconc good (list dir))))))
+            `(,@(let ((v (getenv "PLTCOLLECTS")))
+                  (and v (split-string v ":")))
+                ,(let ((v (getenv "PLTHOME")))
+                   (and v (expand-file-name "collects" v)))
+                ,@(mapcar 'expand-file-name
+                          '("/usr/lib/plt/collects"
+                            "/usr/local/lib/plt/collects"))))
+    good)
+  "*PLT collection directories.
+Listed in order of priority."
+  :type       '(repeat directory)
+  :group      'quack
+  :set        'quack-custom-set
+  :initialize 'custom-initialize-default)
+
+(defcustom quack-fontify-style 'plt
+  "*Which font-lock fontification style to use.
+
+If symbol `plt', an approximation of PLT DrScheme 200 Check Syntax
+fontification will be used.  If symbol `emacs', then fontification in the style
+of GNU Emacs' Scheme Mode with extensions will be used.  If nil, then Quack
+will not override the default Scheme Mode fontification."
+  :type       '(choice (const :tag "PLT Style"                plt)
+                       (const :tag "Extended GNU Emacs Style" emacs)
+                       (const :tag "Emacs Default"            nil))
+  :group      'quack
+  :set        'quack-custom-set
+  :initialize 'custom-initialize-default)
+
+(defcustom quack-pltish-fontify-definition-names-p t
+  "*If non-nil, fontify names in definition forms for PLT-style fontification.
+
+This only has effect when `quack-fontify-style' is `plt'."
+  :type       'boolean
+  :group      'quack
+  :set        'quack-custom-set
+  :initialize 'custom-initialize-default)
+
+(defcustom quack-pltish-fontify-keywords-p t
+  ;; TODO: Rename this from "keywords" to "syntax-keywords", here, and in for
+  ;; face names.
+  "*If non-nil, fontify keywords in PLT-style fontification.
+
+This only has effect when `quack-fontify-style' is `plt'."
+  :type       'boolean
+  :group      'quack
+  :set        'quack-custom-set
+  :initialize 'custom-initialize-default)
+
+(defcustom quack-pltish-keywords-to-fontify
+  ;; TODO: These are currently R5RS and some SRFI special syntax plus a bunch
+  ;; of PLT, especially PLT 200 class.ss, and some "define-"* variants from
+  ;; various dialects, plus some Racket 5.0.2...  The dumbness of this kind of
+  ;; highlighting without regard to context is not really satisfactory.
+  '(
+
+    "and" "begin" "begin-for-syntax"
+    "begin0" "c-declare" "c-lambda" "case" "case-lambda" "class"
+    "class*" "class*/names" "class100" "class100*" "compound-unit/sig" "cond"
+    "cond-expand" "define" "define-class" "define-compound-unit"
+    "define-const-structure"
+    "define-constant" "define-embedded" "define-entry-point" "define-external"
+    "define-for-syntax" "define-foreign-record" "define-foreign-type"
+    "define-foreign-variable" "define-generic" "define-generic-procedure"
+    "define-inline" "define-location" "define-macro" "define-method"
+    "define-module" "define-opt" "define-public" "define-reader-ctor"
+    "define-record" "define-record-printer" "define-record-type"
+    "define-runtime-path"
+    "define-signature"
+    "define-splicing-syntax-class"
+    "define-struct"
+    "define-structure"
+    "define-syntax"
+    "define-syntax-class"
+    "define-syntax-set" "define-values" "define-values-for-syntax"
+    "define-values/invoke-unit/infer"
+    "define-values/invoke-unit/sig" "define/contract" "define/override"
+    "define/private" "define/public" "define/kw"
+    "delay" "do" "doc" "else" "exit-handler" "field"
+    "if" "import" "inherit" "inherit-field" "init" "init-field" "init-rest"
+    "instantiate" "interface" "lambda" "lambda/kw" "let" "let*" "let*-values"
+    "let+"
+    "let-syntax" "let-values" "let/ec" "letrec" "letrec-values" "letrec-syntax"
+    "match-lambda" "match-lambda*" "match-let" "match-let*" "match-letrec"
+    "match-define" "mixin" "module" "module*" "module+" "opt-lambda" "or" "override" "override*"
+    "namespace-variable-bind/invoke-unit/sig" "parameterize" "parameterize*"
+    "parameterize-break" "private"
+    "private*" "protect" "provide" "provide-signature-elements"
+    "provide/contract" "public" "public*" "quasiquote" 
+    "quasisyntax" "quasisyntax/loc" "quote" "receive"
+    "rename" "require" "require-for-syntax" "send" "send*" "set!" "set!-values"
+    "signature->symbols" "super-instantiate" "syntax" "syntax/loc"
+    "syntax-case" "syntax-case*" "syntax-error" "syntax-parse" "syntax-rules"
+    "unit/sig"
+    "unless" "unquote" "unquote-splicing" "when" "with-handlers" "with-handlers*" "with-method"
+    "with-syntax"
+    "define-type-alias"
+    "define-struct:"
+    "define:"
+    "let:"
+    "letrec:"
+    "let*:"
+    "lambda:"
+    "match-let"
+    "plambda:"
+    "case-lambda:"
+    "pcase-lambda:"
+    "require/typed"
+    "require/opaque-type"
+    "require-typed-struct"
+    "struct"
+    "inst"
+    "ann"
+
+    )
+  "*Scheme keywords to fontify when `quack-fontify-style' is `plt'."
+  :type       '(repeat string)
+  :group      'quack
+  :set        'quack-custom-set
+  :initialize 'custom-initialize-default)
+
+(defcustom quack-emacsish-keywords-to-fontify
+  '("and" "begin" "begin0" "call-with-current-continuation"
+    "call-with-input-file" "call-with-output-file" "call/cc" "case"
+    "case-lambda" "class" "cond" "delay" "do" "else" "exit-handler" "field"
+    "for-each" "if" "import" "inherit" "init-field" "interface" "lambda" "let"
+    "let*" "let*-values" "let-values" "let-syntax" "let/ec" "letrec"
+    "letrec-syntax" "map" "mixin" "opt-lambda" "or" "override" "protect"
+    "provide" "public" "rename" "require" "require-for-syntax" "syntax"
+    "syntax-case" "syntax-error" "syntax-rules" "unit/sig" "unless" "when"
+    "with-syntax")
+  "*Scheme keywords to fontify when `quack-fontify-style' is `emacs'."
+  :type       '(repeat string)
+  :group      'quack
+  :set        'quack-custom-set
+  :initialize 'custom-initialize-default)
+
+(defcustom quack-fontify-threesemi-p t
+  "*Whether three-semicolon comments should be fontified differently."
+  :type       'boolean
+  :group      'quack
+  :set        'quack-custom-set
+  :initialize 'custom-initialize-default)
+
+(defcustom quack-pretty-lambda-p nil
+  "*Whether Quack should display \"lambda\" as the lambda character.
+
+`quack-fontify-style' must be `plt'.  Only supported under GNU Emacs version
+21\; not under XEmacs or older GNU Emacs.
+
+Note: Pretty lambda requires that suitable iso8859-7 fonts be available.  Under
+Debian/GNU Linux, for example, these can be downloaded and installed with the
+shell command \"apt-get install 'xfonts-greek-*'\".  If iso8859-7 fonts are
+unavailable for your system, please notify the Quack author."
+  :type       'boolean
+  :group      'quack
+  :set        'quack-custom-set
+  :initialize 'custom-initialize-default)
+
+(defcustom quack-programs
+  '("bigloo" "csi" "csi -hygienic" "gosh" "gracket" "gsi"
+    "gsi ~~/syntax-case.scm -" "guile" "kawa" "mit-scheme" "racket"
+    "racket -il typed/racket" "rs" "scheme" "scheme48" "scsh" "sisc" "stklos"
+    "sxi")
+  "List of Scheme interpreter programs that can be used with `run-scheme'.
+
+These names will be accessible via completion when `run-scheme' prompts for
+which program to run."
+  :group      'quack
+  :type       '(repeat string)
+  :set        'quack-custom-set
+  :initialize 'custom-initialize-default)
+
+(defcustom quack-default-program "mzscheme"
+  "Default Scheme interpreter program to use with `run-scheme'."
+  :group 'quack
+  :type  'string)
+
+(defcustom quack-run-scheme-always-prompts-p t
+  "`run-scheme' should always prompt for which program to run.
+
+If nil, `run-scheme' will always use `quack-default-program' when invoked
+interactively without a prefix argument; this is closest to the behavior of the
+`cmuscheme' package."
+  :group 'quack
+  :type  'boolean)
+
+(defcustom quack-run-scheme-prompt-defaults-to-last-p t
+  "If non-nil, `run-scheme' prompt should default to the last program run."
+  :group 'quack
+  :type  'boolean)
+
+(defcustom quack-remember-new-programs-p t
+  "Programs are added to `quack-programs' automatically."
+  :group 'gigule
+  :type  'boolean)
+
+(defcustom quack-switch-to-scheme-method 'other-window
+  "Method to use for choosing a window and frame for the process buffer.
+
+One of three symbols:
+`other-window' will split display in a different window in the current frame,
+splitting the current window if necessary.
+`own-frame' will display the process buffer in its own frame.
+`cmuscheme' will use the normal behavior of the `cmuscheme' package."
+  :group  'quack
+  :type   '(choice (const :tag "Other Window"       other-window)
+                   (const :tag "Own Frame"          own-frame)
+                   (const :tag "Cmuscheme Behavior" cmuscheme)))
+
+(defcustom quack-warp-pointer-to-frame-p t
+  "Warp mouse pointer to frame with Scheme process buffer.
+
+When `quack-switch-to-scheme-method' is `own-frame', `switch-to-scheme' will
+warp the mouse pointer to the frame displaying the Scheme process buffer."
+  :group 'quack
+  :type  'boolean)
+
+(defcustom quack-newline-behavior 'newline-indent
+  "*Behavior of the RET key in Scheme-Mode buffers.  The value is one of three
+symbols: `newline' inserts a normal newline, `newline-indent' \(the default\)
+inserts a newline and leaves the point properly indented on the new line, and
+`indent-newline-indent' indents the current line before inserting a newline and
+indenting the new one."
+  :type '(choice (const 'newline)
+                 (const 'newline-indent)
+                 (const 'indent-newline-indent))
+  :group 'quack)
+
+(defcustom quack-smart-open-paren-p nil
+  "The `[' can be used to insert `(' characters.
+Actually, this just makes the `(' and '[' keys both insert `(', unless given a
+prefix argument.  This makes typing parens easier on typical keyboards for
+which `(' requires a shift modifier but `[' does not.  A later version of Quack
+might add actual \"smart\" support for automatic PLT-esque insertion of `['
+instead of `(' in some syntactic contexts."
+  :group 'quack
+  :type  'boolean)
+
+(defcustom quack-options-persist-p t
+  "Option menu settings and programs persist using the `custom' facility.
+
+Note that the value of this option itself cannot be set persistently via the
+option menu -- you must use the `customize' interface or set it manually in an
+Emacs startup file.  This is by design, to avoid the risk of users accidentally
+disabling their ability to set persistent options via the option menu."
+  :group 'quack
+  :type  'boolean)
+
+(defcustom quack-quiet-warnings-p t     ; TODO: Options menu.
+  "Warning messages are quiet and subtle."
+  :group 'quack
+  :type  'boolean)
+
+(defconst quack-pltish-comment-face 'quack-pltish-comment-face)
+(defface  quack-pltish-comment-face
+  '((((class color) (background light)) (:foreground "cyan4"))
+    (((class color) (background dark))  (:foreground "cyan1"))
+    (t                                  (:slant italic)))
+  "Face used for comments when `quack-fontify-style' is `plt'."
+  :group 'quack)
+
+(defconst quack-pltish-selfeval-face 'quack-pltish-selfeval-face)
+(defface  quack-pltish-selfeval-face
+  '((((class color) (background light)) (:foreground "green4"))
+    (((class color) (background dark))  (:foreground "green2"))
+    (t                                  ()))
+  "Face used for self-evaluating forms when `quack-fontify-style' is `plt'."
+  :group 'quack)
+
+(defconst quack-pltish-paren-face 'quack-pltish-paren-face)
+(defface  quack-pltish-paren-face
+  '((((class color) (background light)) (:foreground "red3"))
+    (((class color) (background dark))  (:foreground "red1"))
+    (((class grayscale))                (:foreground "gray"))
+    (t                                  ()))
+  "Face used for parentheses when `quack-fontify-style' is `plt'."
+  :group 'quack)
+
+(defconst quack-pltish-colon-keyword-face 'quack-pltish-colon-keyword-face)
+(defface  quack-pltish-colon-keyword-face
+  '((t (:bold t :foreground "gray50")))
+  "Face used for `#:' keywords when `quack-fontify-style' is `plt'.
+Note that this isn't based on anything in PLT."
+  :group 'quack)
+
+(defconst quack-pltish-paren-face 'quack-pltish-paren-face)
+(defface  quack-pltish-paren-face
+  '((((class color) (background light)) (:foreground "red3"))
+    (((class color) (background dark))  (:foreground "red1"))
+    (((class grayscale))                (:foreground "gray"))
+    (t                                  ()))
+  "Face used for parentheses when `quack-fontify-style' is `plt'."
+  :group 'quack)
+
+(defconst quack-banner-face 'quack-banner-face)
+(defface  quack-banner-face
+  '((t (:family "Helvetica")))
+  "Face used in the inferior process buffer for the MzScheme banner.
+
+Currently only takes effect when `quack-fontify-style' is `plt'."
+  :group 'quack)
+
+(defconst quack-pltish-defn-face 'quack-pltish-defn-face)
+(defface  quack-pltish-defn-face
+  '((((class color) (background light)) (:bold t :foreground "blue3"))
+    (((class color) (background dark))  (:bold t :foreground "blue1"))
+    (t                                  (:bold t :underline t)))
+  "Face used for names in toplevel definitions.
+
+For PLT-style when `quack-pltish-fontify-definition-names-p' is non-nil."
+  :group 'quack)
+
+(defconst quack-pltish-class-defn-face 'quack-pltish-class-defn-face)
+(defface  quack-pltish-class-defn-face
+  '((((class color) (background light))
+     (:foreground "purple3" :inherit quack-pltish-defn-face))
+    (((class color) (background dark))
+     (:foreground "purple1" :inherit quack-pltish-defn-face))
+    (t (:inherit quack-pltish-defn-face)))
+  "Face used for class names in toplevel definitions.
+
+For PLT-style when `quack-pltish-fontify-definition-names-p' is non-nil."
+  :group 'quack)
+
+(defconst quack-pltish-module-defn-face 'quack-pltish-module-defn-face)
+(defface  quack-pltish-module-defn-face
+  '((((class color) (background light))
+     (:foreground "purple3" :inherit quack-pltish-defn-face))
+    (((class color) (background dark))
+     (:foreground "purple1" :inherit quack-pltish-defn-face))
+    (t (:inherit quack-pltish-defn-face)))
+  "Face used for module names in toplevel definitions.
+
+For PLT-style when `quack-pltish-fontify-definition-names-p' is non-nil."
+  :group 'quack)
+
+(defconst quack-pltish-keyword-face 'quack-pltish-keyword-face)
+(defface  quack-pltish-keyword-face
+  '((t (:bold t)))
+  "Face used for keywords in PLT Style fontification.
+
+For PLT-style when `quack-pltish-fontify-keywords-p' is non-nil."
+  :group 'quack)
+
+(defconst quack-threesemi-semi-face 'quack-threesemi-semi-face)
+(defface  quack-threesemi-semi-face
+  '((((class color) (background light))
+     (:foreground "#a0ffff":background "#c0ffff"))
+    (((class color) (background dark))
+     (:foreground "cyan2" :background "cyan4"))
+    (t (:slant italic)))
+  "Face used for `;;;' semicolons when `quack-fontify-threesemi-p' is non-nil."
+  :group 'quack)
+
+(defconst quack-threesemi-text-face 'quack-threesemi-text-face)
+(defface  quack-threesemi-text-face
+  '((((class color) (background light))
+     (:foreground "cyan4" :background "#c0ffff"))
+    (((class color) (background dark))
+     (:foreground "white" :background "cyan4"))
+    (t (:slant italic)))
+  "Face used for `;;;' text when `quack-fontify-threesemi-p' is non-nil."
+  :group 'quack)
+
+(defconst quack-threesemi-h1-face 'quack-threesemi-h1-face)
+(defface  quack-threesemi-h1-face
+  '((t (:bold t :family "Helvetica" :height 1.4 :size "20pt")))
+  "Face used for H1 headings in `;;;' text."
+  :group 'quack)
+
+(defconst quack-threesemi-h2-face 'quack-threesemi-h2-face)
+(defface  quack-threesemi-h2-face
+  '((t (:bold t :family "Helvetica" :height 1.2 :size "16pt")))
+  "Face used for H2 headings in `;;;' text."
+  :group 'quack)
+
+(defconst quack-threesemi-h3-face 'quack-threesemi-h3-face)
+(defface  quack-threesemi-h3-face
+  '((t (:bold t :family "Helvetica")))
+  "Face used for H3 headings in `;;;' text."
+  :group 'quack)
+
+(defconst quack-pltfile-prologue-face 'quack-pltfile-prologue-face)
+(defface  quack-pltfile-prologue-face
+  '((((class color))     (:foreground "black" :background "gray66"))
+    (((class grayscale)) (:foreground "black" :background "gray66"))
+    (t                   ()))
+  "Face used for the prologue in a decoded PLT package buffer."
+  :group 'quack)
+
+(defconst quack-pltfile-dir-face 'quack-pltfile-dir-face)
+(defface  quack-pltfile-dir-face
+  '((((class color))     (:bold t :foreground "white" :background "gray33"
+                                :family "Helvetica" :height 1.2 :size "20pt"))
+    (((class grayscale)) (:bold t :foreground "white" :background "gray33"
+                                :family "Helvetica" :height 1.2 :size "20pt"))
+    (t                   (:bold t :inverse-video t)))
+  "Face used for directory headers in a decoded PLT package buffer."
+  :group 'quack)
+
+(defconst quack-pltfile-file-face 'quack-pltfile-file-face)
+(defface  quack-pltfile-file-face
+  '((((class color))     (:bold t :foreground "black" :background "gray66"
+                                :family "Helvetica" :height 1.2 :size "20pt"))
+    (((class grayscale)) (:bold t :foreground "black" :background "gray66"
+                                :family "Helvetica" :height 1.2 :size "20pt"))
+    (t                   (:bold t :inverse-video t)))
+  "Face used for file headers in a decoded PLT package buffer."
+  :group 'quack)
+
+(defconst quack-about-title-face 'quack-about-title-face)
+(defface  quack-about-title-face
+  '((((class color) (background light))
+     (:bold t :family "Helvetica" :foreground "#008000"
+            :height 2.0 :size "24pt"))
+    (((class color) (background dark))
+     (:bold t :family "Helvetica" :foreground "#00f000"
+            :height 2.0 :size "24pt"))
+    (t               (:bold t :family "Helvetica"
+                            :height 2.0 :size "24pt")))
+  "Face used for Quack name in About Quack."
+  :group 'quack)
+
+(defconst quack-about-face 'quack-about-face)
+(defface  quack-about-face
+  '((t (:family "Helvetica")))
+  "Face used for the body text in About Quack."
+  :group 'quack)
+
+(defconst quack-smallprint-face 'quack-smallprint-face)
+(defface  quack-smallprint-face
+  '((t (:family "Courier" :height 0.8 :size "8pt")))
+  "Face used for the \"small print\" in About Quack."
+  :group 'quack)
+
+;; Compatibility/Portability Misc. Kludges:
+
+;; Note: Some compatibility gotchas found while porting Quack that aren't
+;; addressed by macros and functions:
+;;
+;;   * `defface' in Emacs 21 supports ":weight bold", but this is silently
+;;     ignored under older Emacsen, so ":bold t" must be used instead.
+;;
+;;   * Third argument of `detect-coding-region' is different in Emacs 21 and
+;;     XEmacs 21, so only use the first two args.
+;;
+;;   * Under XEmacs 21, characters are `equal' but not `eq' to their integer
+;;     ASCII values
+;;
+;;   * GNU Emacs 21 faces have `:height' property that is either absolute
+;;     decipoints or relative scaling factor.  XEmacs 21 faces instead have
+;;     `:size' property, which appears to be absolute point or mm size.
+;;
+;;   * XEmacs 21 text properties appear to be front-sticky, and there did not
+;;     seem to be any documentation references to stickiness.
+;;
+;;   * XEmacs 21 `local-variable-p' has second argument mandatory.
+;;
+;;   * XEmacs 21 does not display submenu labels at all unless the submenu has
+;;     content.  For inactive submenus, an empty string suffices for content.
+;;
+;;   * XEmacs 21 doesn't support composite characters (which we use for very
+;;     nice pretty lambda under GNU Emacs).
+
+(eval-and-compile
+  (defvar quack-xemacs-p (eval '(and (boundp 'running-xemacs) running-xemacs)))
+  (defvar quack-gnuemacs-p (not quack-xemacs-p)))
+
+(defmacro quack-when-xemacs (&rest args)
+  (if quack-xemacs-p (cons 'progn args) 'nil))
+
+(defmacro quack-when-gnuemacs (&rest args)
+  (if quack-gnuemacs-p (cons 'progn args) 'nil))
+
+(defmacro quack-define-key-after (keymap key definition &optional after)
+  (if quack-gnuemacs-p
+      `(define-key-after ,keymap ,key ,definition ,after)
+    `(define-key ,keymap ,key (prog1 ,definition ,after))))
+
+(defmacro quack-delete-horizontal-space (&rest args)
+  (if (and quack-gnuemacs-p (>= emacs-major-version 21))
+      `(delete-horizontal-space ,@args)
+    `(delete-horizontal-space)))
+
+(defmacro quack-match-string-no-properties (&rest args)
+  `(,(if quack-xemacs-p 'match-string 'match-string-no-properties) ,@args))
+
+(defmacro quack-menufilter-return (name form)
+  (if (= emacs-major-version 20)
+      ;; Note: This isn't working in Emacs 20.  Menu displays now but actions
+      ;;       are not executed.  No answer to test case posted to comp.emacs
+      ;;       and then to gnu.emacs.help.  In response to my subsequent bug
+      ;;       report against Emacs, RMS says that, if this is indeed a bug,
+      ;;       then nothing will be done, since 20 is no longer supported.  I'm
+      ;;       going to let this quietly not work unless someone emails me that
+      ;;       they're actually using Emacs 20.
+      `(easy-menu-filter-return (easy-menu-create-menu ,name ,form))
+    form))
+
+(defmacro quack-propertize (obj &rest props)
+  (if (and quack-gnuemacs-p (>= emacs-major-version 21))
+      `(propertize ,obj ,@props)
+    (let ((obj-var 'quack-propertize-G-obj))
+      `(let ((,obj-var ,obj))
+         (add-text-properties 0 (length ,obj-var) (list ,@props) ,obj-var)
+         ,obj-var))))
+
+(eval-when-compile
+  (when quack-xemacs-p
+    (defvar inhibit-eol-conversion)
+    (defvar minibuffer-allow-text-properties)))
+
+;; Compatibility/Portability Hash Table:
+
+(eval-and-compile
+  (defmacro quack-make-hash-table (&rest args)
+    `(,(if (>= emacs-major-version 21)
+           'make-hash-table
+         'quack-fake-make-hash-table)
+      ,@args)))
+
+(defmacro quack-puthash (key value table)
+  (list (if (>= emacs-major-version 21) 'puthash 'quack-fake-puthash)
+        key value table))
+
+(defmacro quack-gethash (key table &optional dflt)
+  (list (if (>= emacs-major-version 21) 'gethash 'quack-fake-gethash)
+        key table dflt))
+
+(defun quack-fake-make-hash-table (&rest args)
+  ;; TODO: Parse the keyword args and make this do 'assoc or 'assq, as
+  ;;       appropriate.  Currently, this package only needs 'assoc.
+  (vector 'assoc '()))
+
+(defun quack-fake-puthash (key value table)
+  (let ((pair (funcall (aref table 0) key (aref table 1))))
+    (if pair
+        (setcdr pair value)
+      (aset table 1 (cons (cons key value) (aref table 1))))))
+
+(defun quack-fake-gethash (key table &optional dflt)
+  (let ((pair (funcall (aref table 0) key (aref table 1))))
+    (if pair (cdr pair) dflt)))
+
+;; Compatibility/Portability Overlays/Extents:
+
+;; TODO: Maybe get rid of overlays (and the XEmacs extent kludge), and just use
+;;       text properties instead.
+
+(defmacro quack-make-face-ovlext (beg end face)
+  (if quack-xemacs-p
+      `(set-extent-property (make-extent ,beg ,end) 'face ,face)
+    `(overlay-put (make-overlay ,beg ,end) 'face ,face)))
+
+(defmacro quack-make-hiding-ovlext (beg end)
+  (if quack-xemacs-p
+      `(set-extent-property (make-extent ,beg ,end) 'invisible t)
+    `(overlay-put (make-overlay ,beg ,end) 'category 'quack-hiding-ovlcat)))
+
+;; Messages, Errors, Warnings:
+
+(defmacro quack-activity (what &rest body)
+  (let ((var-what (make-symbol "quack-activity-G-what")))
+    `(let ((,var-what ,what))
+       (message (concat ,var-what "..."))
+       (prog1 (progn ,@body)
+         (message (concat ,var-what "...done"))))))
+
+(defun quack-internal-error (&optional format &rest args)
+  (if format
+      (apply 'error (concat "Quack Internal Error: " format) args)
+    (error "Quack Internal Error.")))
+
+(defun quack-warning (format &rest args)
+  (apply 'message (concat "Quack Warning: " format) args)
+  (unless quack-quiet-warnings-p
+    (beep)
+    (sleep-for 1)))
+
+;; Regular Expressions:
+
+(defun quack-re-alt (&rest regexps)
+  (concat "\\(" (mapconcat 'identity regexps "\\|") "\\)"))
+
+(defun quack-re-optional (&rest regexps)
+  (concat "\\("
+          (apply 'concat regexps)
+          "\\)?"))
+
+;; Misc.:
+
+;; (defun quack-abbreviate-file-name (file-name)
+;;   (let ((directory-abbrev-alist '()))
+;;     (abbreviate-file-name file-name)))
+
+(defun quack-delete-file-if-can (file)
+  (condition-case nil (delete-file file) (error nil)))
+
+(defun quack-expand-file-name (name-or-names &optional directory)
+  ;; Note: This only works for systems with Unix-like filenames.
+  (expand-file-name (if (listp name-or-names)
+                        (mapconcat 'identity name-or-names "/")
+                      name-or-names)
+                    directory))
+
+(defun quack-kill-current-buffer ()
+  (interactive)
+  (kill-buffer (current-buffer)))
+
+(defun quack-line-at-point ()
+  (save-excursion
+    (buffer-substring-no-properties
+     (progn (beginning-of-line) (point))
+     (progn (end-of-line)       (point)))))
+
+(defun quack-looking-at-backward (re &optional limit)
+  (save-excursion
+    (save-restriction
+      (let ((start-pt (point)))
+        (narrow-to-region (point-min) (point))
+        (and (re-search-backward re limit t)
+             (= (match-end 0) start-pt)
+             (match-beginning 0))))))
+
+(defun quack-looking-at-close-paren-backward ()
+  (save-match-data
+    (quack-looking-at-backward "[])][ \t\r\n\f]*")))
+
+(defun quack-looking-at-open-paren-backward ()
+  (save-match-data
+    (quack-looking-at-backward "[[(][ \t\r\n\f]*")))
+
+(defun quack-make-directory (dir)
+  (setq dir (file-name-as-directory dir))
+  (unless (file-directory-p dir)
+    (make-directory dir t)))
+
+(defun quack-make-directory-for-file (file)
+  (let ((dir (file-name-directory file)))
+    (when dir (quack-make-directory dir))))
+
+(defun quack-propertize-bold (str)
+  (quack-propertize str 'face 'bold))
+
+(defun quack-propertize-face (str face)
+  (quack-propertize str 'face face))
+
+(defun quack-propertize-italic (str)
+  (quack-propertize str 'face 'italic))
+
+(defun quack-sort-string-list-copy (lst)
+  (sort (copy-sequence lst) 'string<))
+
+(defun quack-uncomment-region (beg end)
+  ;; TODO: Make a quack-toggle-commentout-region.
+  (interactive "r")
+  (comment-region beg end '(4)))
+
+(defun quack-without-side-whitespace (str)
+  ;; Copied from `padr-str-trim-ws' by author.
+  ;;
+  ;; TODO: Don't make an intermediate string.  Use regexp match start position.
+  (save-match-data
+    (if (string-match "^[ \t\n\r]+" str)
+        (setq str (substring str (match-end 0))))
+    (if (string-match "[ \t\n\r]+$" str)
+        (setq str (substring str 0 (match-beginning 0))))
+    str))
+
+;; Kludgey Sexp Buffer Operations:
+
+(defconst quack-backward-sexp-re
+  (concat "\\`"
+          (quack-re-alt "[^\";\\\\]"
+                        "\\\\\\."
+                        (concat "\""
+                                (quack-re-alt "[^\"\\\\]"
+                                              "\\\\\\.")
+                                "*\""))
+          "*\\([\"\\\\]\\)?"))
+
+(defun quack-backward-sexp ()
+  ;; Returns non-nil iff point was in a string literal or comment.
+  (interactive)
+  (when (bobp)
+    (error "beginning of buffer"))
+  (save-match-data
+    (let* ((orig (point))
+           (bol  (progn (beginning-of-line) (point))))
+      (if (string-match quack-backward-sexp-re
+                        (buffer-substring-no-properties bol orig))
+          (if (match-beginning 3)
+              ;; We're in what appears to be a comment or unterminated string
+              ;; literal (though might not be, due to multi-line string
+              ;; literals and block comments), so move point to the beginning.
+              (progn (goto-char (+ bol (match-beginning 3)))
+                     t)
+            ;; We don't appear to be in a comment or string literal, so just
+            ;; let `backward-sexp' do its thing.
+            (goto-char orig)
+            (backward-sexp)
+            nil)))))
+
+(defun quack-parent-sexp-search (name-regexp &optional max-depth max-breadth)
+  (save-match-data
+    (save-excursion
+      (let ((max-depth   (or max-depth   100))
+            (max-breadth (or max-breadth 100))
+            (orig-point  (point))
+            (found       'looking)
+            (depth       0)
+            (child-start nil))
+        (while (and (eq found 'looking) (< depth max-depth))
+          (condition-case nil
+              (let ((breadth 0))
+                ;; Loop until we hit max breadth or error.
+                (while (< breadth max-breadth)
+                  (when (and (quack-backward-sexp) (not child-start))
+                    (setq child-start (point)))
+                  (setq breadth (1+ breadth)))
+                ;; We hit our max breadth without erroring, so set the found
+                ;; flag to indicate failure and then fall out of our loop.
+                (setq found nil))
+            (error                      ; scan-error
+             ;; We probably hit the beginning of the enclosing sexp, and point
+             ;; should be on the first sexp, which will most often be the form
+             ;; name, so first check that there really is an open paren to our
+             ;; left, and then check if it matches our regexp.
+             (let ((paren-start (quack-looking-at-open-paren-backward)))
+               (if paren-start
+                   ;; There is a paren, so check the name of the form.
+                   (if (and (looking-at name-regexp)
+                            (quack-not-symbol-char-at-point-p (match-end 0)))
+                       ;; Found it, so set the result to a list (lexeme, lexeme
+                       ;; end point, last nested child sexp start point, parent
+                       ;; paren start point) and then fall out of our loop.
+                       ;; Note that we return the original point if no child
+                       ;; point was found, on the assumption that point was at
+                       ;; the beginning of the child sexp (unless it was within
+                       ;; the found form name, in which case child sexp start
+                       ;; is nil).
+                       (setq found (list (quack-match-string-no-properties 0)
+                                         (match-end 0)
+                                         (or child-start
+                                             (if (> orig-point (match-end 0))
+                                                 orig-point))
+                                         paren-start))
+                     ;; This form name didn't match, so try to move up in the
+                     ;; paren syntax (which will usually mean moving left one
+                     ;; character).
+                     (condition-case nil
+                         (progn (up-list -1)
+                                (setq child-start (point))
+                                (setq depth (1+ depth)))
+                       (error           ; scan-error
+                        ;; We can't go up here, so set found flag to indicate
+                        ;; failure and then fall out of the loop.
+                        (setq found nil))))
+                 ;; There wasn't a paren, which means we hit a scan error for
+                 ;; some reason other than being at the beginning of the sexp,
+                 ;; so consider the search a failure
+                 (setq found nil))))))
+        (if (eq found 'looking)
+            nil
+          found)))))
+
+;; TODO: We really need a global definition of what are Scheme symbol
+;;       constituent characters (or a whole-symbol regexp)!
+
+(defun quack-not-symbol-char-at-point-p (pt)
+  ;; This is used to check for a symbol boundary point.
+  (save-match-data
+    (or (= pt (point-max))
+        (if (string-match "[^-a-zA-Z0-9!+<=>$%&*./:@^_~]"
+                          (buffer-substring-no-properties pt (1+ pt)))
+            t))))
+
+;; String Constant Hashtable:
+
+(eval-and-compile
+  (if (< emacs-major-version 21)
+
+      (defun quack-strconst (str) str)
+
+    (defvar quack-strconst-hashtable
+      (if (>= emacs-major-version 21)
+          (quack-make-hash-table :test 'equal :size 1000)))
+
+    (defun quack-strconst (str)
+      (unless (stringp str)
+        (error "Non-string object passed to quack-strconst: %s" str))
+      (or (quack-gethash str quack-strconst-hashtable nil)
+          (quack-puthash str str quack-strconst-hashtable)
+          str))))
+
+;; Web URLs:
+
+(defun quack-quote-url-substring (str &optional quote-slash-p always-new-p)
+  (save-match-data
+    (let ((regexp (if quote-slash-p "[^-_.A-Za-z0-9]" "[^-_.A-Za-z0-9/]"))
+          (subs   '())
+          (len    (length str))
+          (start  0))
+      (while (and (> len start)
+                  (string-match regexp str start))
+        (let ((beg (match-beginning 0))
+              (end (match-end       0)))
+          (when (> beg start)
+            (setq subs (cons (substring str start beg) subs)))
+          (setq subs (cons (format "%%%X" (aref str beg)) subs))
+          (setq start end)))
+      (if subs
+          (apply 'concat (reverse (if (> len start)
+                                      (cons (substring str start len) subs)
+                                    subs)))
+        (if always-new-p (copy-sequence str) str)))))
+
+(defun quack-file-url (dir file)
+  ;; TODO: This is Unix-centric and a little fragile.  Rewrite eventually.
+  (concat "file:"
+          (quack-quote-url-substring dir)
+          "/"
+          (or (quack-quote-url-substring file) "")))
+
+(defun quack-build-url (base path)
+  (let ((base-slash-p (= (aref base (1- (length base))) ?\/)))
+    (if path
+        (mapconcat 'identity
+                   (cons (if base-slash-p
+                             (substring base 0 -1)
+                           base)
+                         path)
+                   "/")
+      (if base-slash-p
+          base
+        (concat base "/")))))
+
+;; Web Browsing:
+
+(defun quack-browse-url (url)
+  (require 'browse-url)
+  (message "Quack viewing URL: %s" url)
+  (let ((browse-url-browser-function (or quack-browse-url-browser-function
+                                         browse-url-browser-function)))
+    (browse-url url)))
+
+(defun quack-browse-quack-web-page ()
+  (interactive)
+  (quack-browse-url quack-web-page))
+
+(defun quack-w3m-browse-url-other-window (url &optional new-window)
+  (interactive (eval '(browse-url-interactive-arg "URL: ")))
+  (unless (string= (buffer-name) "*w3m*")
+    (switch-to-buffer-other-window (current-buffer)))
+  ;; TODO: If `*w3m*' buffer is visible in current frame or other frame,
+  ;;       switch to that, for Emacsen that don't do that by default.
+  (eval '(w3m-browse-url url nil)))
+
+;; Web Getting:
+
+(defconst quack-web-get-log-buffer-name "*quack-web-get*")
+
+(defun quack-web-get-to-file (url out-file)
+  ;; TODO: Support other getting tools, such as "lynx -source", "links
+  ;;       -source", "w3m -dump_source", and the Emacs w3 package.  Most of
+  ;;       these send the Web content to stdout, so, unlike for wget, it will
+  ;;       be easier to insert directly to a buffer and send stderr to a temp
+  ;;       file.  We should have *-to-file-* and *-insert-via-* functions for
+  ;;       each external downloader program anyway.
+  (quack-make-directory-for-file out-file)
+  (quack-web-get-to-file-via-wget url out-file))
+
+;;(defun quack-web-get-to-temp-file (url)
+;;  (let ((temp-file (quack-make-temp-file "web-get")))
+;;    (quack-web-get-to-file url temp-file)
+;;    temp-file))
+
+(defun quack-web-get-to-file-via-wget (url out-file)
+  ;; TODO: Make this initially download to a temp file; replace any
+  ;;       pre-existing out-file after successful download.  Do this for any
+  ;;       external downloader programs that write to the specified output file
+  ;;       before the download is complete.
+  (let ((window    (selected-window))
+        (saved-buf (current-buffer))
+        (log-buf   (get-buffer-create quack-web-get-log-buffer-name)))
+    (unwind-protect
+        (progn
+          ;; Prepare the log buffer.
+          (set-buffer log-buf)
+          (widen)
+          (buffer-disable-undo)
+          (goto-char (point-min))
+          (delete-region (point-min) (point-max))
+          (set-window-buffer window log-buf)
+          ;; Do the wget.
+          (quack-activity
+           (format "Getting %S via wget" url)
+           (let ((status (call-process "wget" nil t t
+                                       "-O" out-file "-t" "1" "--" url)))
+             (unless (= status 0)
+               (quack-delete-file-if-can out-file)
+               (error "Could not get %S via wget." url))
+             (kill-buffer log-buf)
+             out-file)))
+      ;; unwind-protect cleanup
+      (set-window-buffer window saved-buf)
+      (set-buffer saved-buf))))
+
+;; HTML Kludges:
+
+(defun quack-strip-limited-html-tags (str)
+  (save-match-data
+    (let ((case-fold-search t)
+          (str-len          (length str))
+          (frags            '())
+          (start            0))
+      (while (string-match "" str start)
+        (when (> (match-beginning 0) start)
+          (setq frags (cons (substring str start (match-beginning 0)) frags)))
+        (setq start (match-end 0)))
+      (if frags
+          (progn (when (< start str-len)
+                   (setq frags (cons (substring str start) frags)))
+                 (apply 'concat (reverse frags)))
+        str))))
+
+;; Temp Files:
+
+(defun quack-temp-dir ()
+  (file-name-as-directory (expand-file-name "tmp" quack-dir)))
+
+;; TODO: Make sure this gets executed in load phase even if byte-compiled.
+
+(random t)
+
+(defun quack-make-temp-file (purpose-str)
+  ;; Note: There is an obvious race condition here.  But we're trying to do
+  ;;       this in portable Elisp, and if user's `quack-dir' is writable by
+  ;;       someone other than user, then user has bigger problems.
+  (save-excursion
+    (let* ((buf (generate-new-buffer "*quack-make-temp-file*"))
+           (dir (quack-temp-dir))
+           file)
+      (set-buffer buf)
+      (quack-make-directory dir)
+      (while (progn (setq file (expand-file-name (format "%d-%s-%d"
+                                                         (emacs-pid)
+                                                         purpose-str
+                                                         (random 10000))
+                                                 dir))
+                    (file-exists-p file)))
+      (set-visited-file-name file)
+      (save-buffer 0)
+      (kill-buffer buf)
+      file)))
+
+;; About:
+
+(defun quack-about ()
+  (interactive)
+  (let* ((buf-name "*About Quack*")
+         (buf      (get-buffer buf-name)))
+    (when buf (kill-buffer buf))
+    (setq buf (get-buffer-create buf-name))
+    (switch-to-buffer buf)
+    (setq buffer-read-only nil)
+    (widen)
+    (fundamental-mode)
+    (when font-lock-mode
+      ;;(quack-warning "Font-lock mode mysteriously on in fundamental-mode.")
+      (font-lock-mode -1))
+    (buffer-disable-undo)
+    ;;(delete-region (point-min) (point-max))
+    (erase-buffer)
+    (insert
+     "\n"
+     (quack-propertize-face (copy-sequence "Quack") 'quack-about-title-face)
+     "   Version "
+     (quack-propertize-bold (copy-sequence quack-version))
+     "\n"
+     (quack-propertize-italic
+      (copy-sequence "Enhanced Emacs support for Scheme programming"))
+     "\n\n"
+     "You can email bug reports and feature requests to the author,\n"
+     quack-author-name
+     " <"
+     quack-author-email
+     ">.  Mention that\n"
+     "you are using "
+     (quack-propertize-bold
+      (copy-sequence
+       (cond (quack-gnuemacs-p "GNU Emacs")
+             (quack-xemacs-p   "XEmacs")
+             (t                "*an unrecognized Emacs kind*"))))
+     " "
+     (quack-propertize-bold
+      (format "%d.%d" emacs-major-version emacs-minor-version))
+     " on "
+     (quack-propertize-bold (copy-sequence system-configuration))
+     ".\n\n"
+     "To be notified via email when new Quack versions are released,\n"
+     "ask Neil to add you to the moderated "
+     (quack-propertize-bold "scheme-announce")
+     " list.\n\n"
+     "Visit the Web page:  "
+     quack-web-page
+     "\n")
+    (insert "\n\n"
+            (quack-propertize-face (copy-sequence quack-copyright)
+                                   'quack-smallprint-face)
+            "\n"
+            (quack-propertize-face (copy-sequence quack-copyright-2)
+                                   'quack-smallprint-face)
+            "\n\n"
+            (quack-propertize-face (concat quack-legal-notice "\n")
+                                   'quack-smallprint-face))
+    (goto-char (point-min))
+    (set-buffer-modified-p nil)
+    (setq buffer-read-only t)
+    (local-set-key "q" 'quack-kill-current-buffer)
+    (local-set-key "w" 'quack-browse-quack-web-page)
+    (message
+     "Press `q' to quit *About Quack*, `w' to visit the Quack Web page.")))
+
+;; PLT Collections:
+
+(defvar quack-pltcollects-alist-cache nil)
+
+(defun quack-invalidate-pltcollects-caches ()
+  (setq quack-pltcollects-alist-cache nil)
+  (quack-invalidate-manuals-caches))
+
+(defun quack-pltcollects-alist ()
+  (or quack-pltcollects-alist-cache
+      (quack-activity
+       "Scanning PLT collection directories"
+       (let ((result '()))
+         (mapcar (function
+                  (lambda (dir)
+                    (mapcar (function
+                             (lambda (subdir)
+                               (unless (member subdir '("." ".." "CVS" "RCS"))
+                                 (let ((subdir-path (expand-file-name subdir
+                                                                      dir)))
+                                   (when (file-directory-p subdir-path)
+                                     (setq result
+                                           (cons (cons subdir subdir-path)
+                                                 result)))))))
+                            (condition-case nil
+                                (directory-files dir)
+                              (file-error nil)))))
+                 quack-pltcollect-dirs)
+         (setq quack-pltcollects-alist-cache (reverse result))))))
+
+(defun quack-dir-for-pltcollect (name)
+  (cdr (assoc name (quack-pltcollects-alist))))
+
+(defun quack-dired-pltcollect ()
+  (interactive)
+  (let* ((alist   (quack-pltcollects-alist))
+         (default (if (assoc "mzlib" alist) "mzlib" nil))
+         (dir (cdr (assoc
+                    (completing-read
+                     (if default 
+                         (format "Dired for PLT collection (default %S): "
+                                 default)
+                       "Dired for PLT collection: ")
+                     alist nil t nil nil default)
+                    alist))))
+    (and dir (dired dir))))
+
+;; Find File:
+
+(defun quack-shorter-file-relative-name (filename &optional directory)
+  (let ((absolute (expand-file-name   filename directory))
+        (relative (file-relative-name filename directory)))
+    (if (< (length relative) (length absolute))
+        relative
+      absolute)))
+
+;; TODO: Also write `quack-find-file-other-window' and
+;;       `quack-find-file-other-frame' and steal appropriate key bindings.
+
+(defun quack-find-file ()
+  ;; TODO: Hangup/delay problems in mega-huge files.
+  ;;
+  ;; TODO: Handle `(load )'
+  (interactive)
+  (let* ((default (quack-find-file-default))
+         (entry   (let ((insert-default-directory (if default
+                                                      nil
+                                                    insert-default-directory)))
+                    (read-file-name
+                     (if default
+                         (format "Quack find file (default %S): "
+                                 (quack-shorter-file-relative-name
+                                  default
+                                  default-directory))
+                       "Quack find file: ")
+                     default-directory
+                     default))))
+    (find-file (if (string= entry "")
+                   (or default "")
+                 entry))))
+
+(defun quack-find-file-default ()
+  (or (quack-pltrequire-at-point-filename)
+      ;; TODO: Add support for syntax from Guile, SLIB, Chicken, etc.
+      ))
+
+;; TODO: Guile `:use-module' support.  Forget about 1.4, and do 1.6.
+;;
+;; (defun quack-guilecolonusemodule-at-point-data ()
+;;   (save-match-data
+;;     (when (thing-at-point-looking-at
+;;            ":use-module[ \t]+\\(([^][()\"#'`,]+)\\)")
+;;       (condition-case nil
+;;           (car (read-from-string (buffer-substring-no-properties
+;;                                   (match-beginning 1) (match-end 1))))
+;;         (error nil)))))
+;;
+;; ;; (define-module (ice-9 expect) :use-module (ice-9 regex))
+
+;; TODO: Guile 1.6 `use-modules' and `use-syntax' support.
+;;
+;; (use-modules (ice-9 regex))
+;;
+;; (use-modules ((ice-9 popen)
+;;               :select  ((open-pipe . pipe-open) close-pipe)
+;;               :renamer (symbol-prefix-proc 'unixy:)))
+;;
+;; (use-modules { SPEC }+ )
+;;
+;; SPEC ::= MODULE-NAME | (MODULE-NAME [:select SELECTION] [:renamer RENAMER])
+;;
+;; (use-syntax MODULE-NAME)
+
+;; TODO: Support SLIB-style `require' forms:
+;;
+;; (require 'foo)
+
+;; TODO: Bigloo `import' and maybe `extern' support.
+;;
+;; ;; /usr/share/doc/bigloo-examples/examples/Foreign/
+;; (module example
+;;   (import (bis foreign2 "foreign2.scm"))
+;;   ...)
+;;
+;; ;; /usr/share/doc/bigloo-examples/examples/Fork/
+;; (module sys-example
+;;   (extern (include "sys/types.h")
+;;           (include "wait.h")
+;;           (include "unistd.h")
+;;           ...))
+
+;; TODO: PLT module language syntax: (module info (lib "infotab.ss" "setup")
+
+(defconst quack-pltrequire-at-point-data-re
+  (quack-re-alt "dynamic-require"
+                (concat "require"
+                        (quack-re-alt "-for-syntax"
+                                      ""))))
+
+(defconst quack-pltrequire-at-point-data-1-re
+  (concat quack-pltrequire-at-point-data-re
+          "\\>"))
+
+(defconst quack-pltrequire-at-point-data-2-re
+  (concat "[^\r\n]*[[(]"
+          quack-pltrequire-at-point-data-re
+          "[ \t]+\\([^\r\n]+\\)"))
+
+(defun quack-pltrequire-at-point-data-1 ()
+  (save-match-data
+    (let ((qpss (quack-parent-sexp-search quack-pltrequire-at-point-data-1-re
+                                          4)))
+      (when qpss
+        (let ((child-start (nth 2 qpss)))
+          (when child-start
+            (save-excursion
+              (goto-char child-start)
+              (condition-case nil
+                  ;; Note: It is normally OK to use the Elisp reader here.
+                  (read (current-buffer))
+                (error nil)))))))))
+
+(defun quack-pltrequire-at-point-data-2 ()
+  (save-match-data
+    (when (thing-at-point-looking-at quack-pltrequire-at-point-data-2-re)
+      (let* ((read-start (match-beginning 2))
+             (parts-pt   (- (point) read-start))
+             (parts      (buffer-substring-no-properties read-start
+                                                         (match-end 2)))
+             (parts-len  (length parts))
+             (start      0)
+             (result     '()))
+        (condition-case nil
+            (while (< start parts-len)
+              ;; Note: It is normally OK to use the Elisp reader here.
+              (let ((r (read-from-string parts start)))
+                (when (or (not result) (> parts-pt start))
+                  (setq result (car r)))
+                (setq start (cdr r))))
+          (error nil))
+        result))))
+
+(defun quack-pltrequire-at-point-filename (&optional silent)
+  (let* ((d (or (quack-pltrequire-at-point-data-1)
+                (quack-pltrequire-at-point-data-2)))
+         (m (cond
+             ((not     d) nil)
+             ((stringp d) d)
+             ((listp   d)
+              (let ((f (car d)))
+                (when (symbolp f)
+                  (cond ((memq f '(file lib))                 d)
+                        ((memq f '(all-except rename))        (nth 1 d))
+                        ((memq f '(prefix prefix-all-except)) (nth 2 d)))))))))
+    (cond
+     ((stringp m) m)
+     ((listp   m)
+      (let ((f (car m)))
+        (when (symbolp f)
+          (cond ((eq f 'file) (nth 1 f))
+                ((eq f 'lib)
+                 (let* ((file        (nth 1 m))
+                        (collect     (or (nth 2 m) "mzlib"))
+                        (collect-dir (quack-dir-for-pltcollect collect))
+                        (subs        (nthcdr 3 m)))
+                   (when file
+                     (if collect-dir
+                         (quack-expand-file-name (nconc subs (list file))
+                                                 collect-dir)
+                       (unless silent
+                         (quack-warning "Cannot find collection %S" collect))
+                       nil)))))))))))
+
+;; Indenting Newline:
+
+(defun quack-newline (&optional arg)
+  (interactive "*P")
+  (if (eq quack-newline-behavior 'newline)
+      (newline arg)
+    (if (eq quack-newline-behavior 'indent-newline-indent)
+        (lisp-indent-line)
+      (unless (eq quack-newline-behavior 'newline-indent)
+        (error "invalid quack-newline-behavior value: %s"
+               quack-newline-behavior)))
+    (let ((n (prefix-numeric-value arg)))
+      (when (> n 0)
+        (while (> n 0)
+          (setq n (1- n))
+          (quack-delete-horizontal-space t)
+          (newline))
+        (lisp-indent-line)))))
+
+;; Agreeing-Paren Insert:
+
+;; TODO: Make paren-matching within comments limit seaching to within comments,
+;;       not skip back and try to match code.  One workaround is to prefix
+;;       parents/brackets in comments with backslash.
+
+(defun quack-insert-closing (prefix default-close other-open other-close)
+  (insert default-close)
+  (unless prefix
+    (let ((open-pt (condition-case nil
+                       (scan-sexps (point) -1)
+                     (error (beep) nil))))
+      (when open-pt
+        (let ((open-char (aref (buffer-substring-no-properties
+                                open-pt (1+ open-pt))
+                               0)))
+          (when (= open-char other-open)
+            (delete-backward-char 1)
+            (insert other-close))))))
+  (when blink-paren-function (funcall blink-paren-function)))
+
+(defun quack-insert-closing-paren (&optional prefix)
+  (interactive "P")
+  (quack-insert-closing prefix ?\) ?\[ ?\]))
+
+(defun quack-insert-closing-bracket (&optional prefix)
+  (interactive "P")
+  (quack-insert-closing prefix ?\] ?\( ?\)))
+
+;; Opening-Paren Insert:
+
+(defun quack-insert-opening (prefix char)
+  (insert (if (or prefix (not quack-smart-open-paren-p)) char ?\())
+  (when blink-paren-function (funcall blink-paren-function)))
+
+(defun quack-insert-opening-paren (&optional prefix)
+  (interactive "P")
+  (quack-insert-opening prefix ?\())
+
+(defun quack-insert-opening-bracket (&optional prefix)
+  (interactive "P")
+  (quack-insert-opening prefix ?\[))
+
+;; Definition Lambda Syntax Toggling:
+
+(defconst quack-toggle-lambda-re-1
+  (concat "define\\*?"
+          (quack-re-alt "-for-syntax"
+                        "-public"
+                        "/override"
+                        "/private"
+                        "/public"
+                        "")))
+
+(defconst quack-toggle-lambda-re-2
+  (let ((ws-opt      "[ \t\r\n\f]*")
+        (symbol      "[^][() \t\r\n\f]+")
+        (open-paren  "[[(]")
+        (close-paren "[])]"))
+    (concat ws-opt
+            (quack-re-alt               ; #=1
+             (concat "\\("              ; #<2 `NAME (lambda ('
+                     "\\("              ; #<3 name
+                     symbol
+                     "\\)"              ; #>3
+                     ws-opt
+                     open-paren
+                     ws-opt
+                     "lambda"
+                     ws-opt
+                     open-paren
+                     ws-opt
+                     "\\)")
+             (concat "\\("              ; #<4 `(NAME'
+                     open-paren
+                     ws-opt
+                     "\\("              ; #<5 name
+                     symbol
+                     "\\)"              ; #>5
+                     ws-opt
+                     "\\)"))
+            "\\("                       ; #<6 optional close paren
+            close-paren
+            "\\)?"                      ; #>6
+            )))
+
+(defun quack-toggle-lambda ()
+  (interactive)
+  (save-match-data
+    (let ((found (quack-parent-sexp-search quack-toggle-lambda-re-1))
+          last-paren-marker
+          leave-point-marker)
+      (unless found
+        (error "Sorry, this does not appear to be a definition form."))
+      (unwind-protect
+          (let ((lexeme-end (nth 1 found))
+                (define-beg (nth 3 found)))
+
+            ;; Make the markers.
+            (setq last-paren-marker  (make-marker))
+            (setq leave-point-marker (point-marker))
+
+            ;; Move to right after the define form keyword, and match the
+            ;; pattern of the two possible syntaxes.  Error if no match.
+            (goto-char lexeme-end)
+            (unless (looking-at quack-toggle-lambda-re-2)
+              (error "Sorry, we can't grok this definition syntax."))
+
+            ;; Pattern matched, so find the closing paren of the define form.
+            (let ((pt (condition-case nil
+                          (scan-sexps define-beg 1)
+                        (error          ; scan-error
+                         nil))))
+              (if pt
+                  (set-marker last-paren-marker (1- pt))
+                (quack-warning
+                 "This definition form sexp is unclosed.  Consider undo.")))
+
+            ;; Now act based on which syntax we saw.
+            (cond
+
+             ((match-beginning 2)
+              ;; We saw the syntax `NAME (lambda ('.
+              (let ((name (quack-match-string-no-properties 3)))
+                (when (marker-position last-paren-marker)
+                  (goto-char last-paren-marker)
+                  (let ((victim-beg (quack-looking-at-close-paren-backward)))
+                    (unless victim-beg
+                      (error "This definition form should end with `))'."))
+                    (delete-region victim-beg (point))))
+                (goto-char lexeme-end)
+                (delete-region lexeme-end (match-end 2))
+                (insert " (" name (if (match-beginning 6) "" " "))))
+
+             ((match-beginning 4)
+              ;; We saw the syntax `(NAME'.
+              (let ((name (quack-match-string-no-properties 5)))
+                (when (marker-position last-paren-marker)
+                  (goto-char last-paren-marker)
+                  (insert ")"))
+                (goto-char lexeme-end)
+                (delete-region lexeme-end (match-end 4))
+                (insert " " name "\n")
+                (set-marker leave-point-marker (point))
+                (insert "(lambda (")
+                (set-marker-insertion-type leave-point-marker t)))
+
+             (t (quack-internal-error)))
+
+            ;; Reindent, which also takes care of font-lock updating of deleted
+            ;; and inserted text.
+            (indent-region define-beg
+                           (or (marker-position last-paren-marker)
+                               (max (marker-position leave-point-marker)
+                                    (point)))
+                           nil))
+
+        ;; unwind-protect cleanup
+        (goto-char (marker-position leave-point-marker))
+        (set-marker leave-point-marker nil)))))
+
+;; Buffer Tidying:
+
+;; TODO: Maybe have an option to automatically tidy the buffer on save.  Make
+;;       default off.  This can be slow for larger buffers on older computers,
+;;       especially if font-lock is activated.  It can also annoy people who
+;;       have a CM system full of improperly formatted files, or who like
+;;       things like formfeed characters in their files.
+
+(defun quack-delete-all-in-buffer (regexp &optional subexp)
+  (unless subexp (setq subexp 0))
+  ;; Note: This moves the point and changes the match data.
+  (goto-char (point-min))
+  (while (re-search-forward regexp nil t)
+    (goto-char (match-end subexp))
+    (delete-region (match-beginning subexp) (point))))
+
+(defun quack-tidy-buffer ()
+
+  ;; TODO: Make sure this works with odd eol conventions and the various
+  ;;       codeset representations in various versions of Emacs.
+
+  ;; TODO: Maybe detect DrScheme ASCII-art "big letters" and protect them from
+  ;;       reindenting.
+
+  "Tidy the formatting of the current Scheme buffer.
+
+This reindents, converts tabs to spaces, removes trailing whitespace on lines,
+removes formfeed characters, removes extraneous blank lines, and makes sure
+the buffer ends with a newline.
+
+This can conceivably corrupt multi-line string literals, but not in any way
+they wouldn't be corrupted by Usenet, various mailers, typesetting for print,
+etc.
+
+This may also result in large diffs when the tidied file is commited back to a
+version control or configuration management system.  Consider making a VC or CM
+delta that consists only of changes made by `quack-tidy-buffer'."
+  (interactive)
+  (if (= (point-min) (point-max))
+      (message "Buffer is empty; no tidying necessary.")
+    (let ((marker      (point-marker))
+          (fill-prefix nil))
+      (unwind-protect
+          (save-excursion
+            (save-match-data
+              (quack-activity
+               "Tidying buffer"
+
+               ;; Make sure last character is a newline.
+               (unless (string= "\n" (buffer-substring-no-properties
+                                      (1- (point-max))
+                                      (point-max)))
+                 (goto-char (point-max))
+                 (insert "\n"))
+
+               ;; Remove form-feed characters.
+               (quack-delete-all-in-buffer "\f")
+
+               ;; Reindent buffer (without inserting any new tabs).
+               ;; Note: This is the time-consuming pass.
+               (let ((saved-indent-tabs-mode indent-tabs-mode))
+                 (unwind-protect
+                     (progn (setq indent-tabs-mode nil)
+                            (indent-region (point-min) (point-max) nil))
+                   ;; unwind-protect cleanup
+                   (setq indent-tabs-mode saved-indent-tabs-mode)))
+
+               ;; Expand any remaining tabs.
+               (untabify (point-min) (point-max))
+
+               ;; Remove trailing whitespace on each line.
+               (quack-delete-all-in-buffer "\\([ \t\r]+\\)\n" 1)
+
+               ;; Remove blank lines from top.
+               (goto-char (point-min))
+               (when (looking-at "[ \t\r\n]+")
+                 (delete-region (match-beginning 0) (match-end 0)))
+
+               ;; Remove excess adjacent blank lines.
+               (quack-delete-all-in-buffer "\n\n\\(\n+\\)" 1)
+
+               ;; Remove blank lines from bottom.
+               (goto-char (point-max))
+               (when (quack-looking-at-backward
+                      "\n\\(\n\\)"
+                      (max (point-min) (- (point-max) 3)))
+                 (delete-region (match-beginning 1) (match-end 1))))))
+
+        ;; unwind-protect cleanup
+        (goto-char (marker-position marker))
+        (set-marker marker nil)))))
+
+;; SRFIs:
+
+;; TODO: Archive local copies of SRFIs?  Have to update them when modified, but
+;;       without unnecessarily downloading from the master site.  This is
+;;       doable with wget mirroring, but not with things like "lynx -source".
+
+(defconst quack-srfi-subindex-kinds '(draft final withdrawn)
+  "List of symbols representing the three possible states of an SRFI (`draft',
+`final', and `withdrawn'), in order of increasing precedence (e.g., final
+follows draft,since a final version supercedes a draft version).")
+
+(defvar quack-srfi-completes-cache 'invalid)
+(defvar quack-srfi-menu-cache      'invalid)
+
+(defun quack-srfi-completes ()
+  (when (eq quack-srfi-completes-cache 'invalid)
+    (quack-process-srfi-subindex-files))
+  quack-srfi-completes-cache)
+
+(defun quack-srfi-menu (&optional noninteractive)
+  (when (eq quack-srfi-menu-cache 'invalid)
+    (quack-process-srfi-subindex-files noninteractive))
+  quack-srfi-menu-cache)
+
+(defun quack-srfi-master-url (path)
+  (quack-build-url quack-srfi-master-base-url path))
+
+(defun quack-srfi-subindex-master-url (kind)
+  (quack-srfi-master-url (list (quack-srfi-subindex-basename kind))))
+
+(defun quack-srfi-dir ()
+  (file-name-as-directory (expand-file-name "srfi" quack-dir)))
+
+(defun quack-srfi-subindex-file (kind)
+  (expand-file-name (quack-srfi-subindex-basename kind) (quack-srfi-dir)))
+
+(defun quack-srfi-subindex-basename (kind)
+  (format "%S-srfis.html" kind))
+
+(defun quack-invalidate-srfi-index-caches ()
+  (setq quack-srfi-completes-cache 'invalid)
+  (setq quack-srfi-menu-cache      'invalid))
+
+(defun quack-update-srfi-index ()
+  (interactive)
+  (quack-activity
+   "Updating SRFI index"
+   (quack-download-srfi-subindex-files)))
+
+(defun quack-download-srfi-subindex-files ()
+  (quack-invalidate-srfi-index-caches)
+  (mapcar (function
+           (lambda (kind)
+             (quack-activity
+              (format "Downloading %s SRFI subindex" kind)
+              (quack-web-get-to-file (quack-srfi-subindex-master-url kind)
+                                     (quack-srfi-subindex-file       kind)))))
+          quack-srfi-subindex-kinds))
+
+(defun quack-download-srfi-subindex-files-if-missing ()
+  (let ((missing '()))
+    (mapcar (function
+             (lambda (kind)
+               (unless (file-exists-p (quack-srfi-subindex-file kind))
+                 (setq missing (nconc missing (list kind))))))
+            quack-srfi-subindex-kinds)
+    (when (and missing
+               (y-or-n-p "Some cached SRFI subindexes are missing. Update? "))
+      (quack-update-srfi-index))))
+
+(defun quack-process-srfi-subindex-files (&optional noninteractive)
+  (let ((index      '())
+        (completes  '())
+        (menu       (mapcar (function (lambda (kind) (cons kind nil)))
+                            quack-srfi-subindex-kinds)))
+
+    ;; Invalidate dependent caches.
+    (quack-invalidate-srfi-index-caches)
+
+    ;; Give user a chance to download any missing cache files all at once,
+    ;; instead of prompting individually later.
+    (unless noninteractive
+      (quack-download-srfi-subindex-files-if-missing))
+
+    ;; Parse the index files, letting entries for successive states supercede.
+    (mapcar (function
+             (lambda (kind)
+               (mapcar (function
+                        (lambda (new)
+                          (let (old)
+                            (if (setq old (assq (car new) index))
+                                (setcdr old (cdr new))
+                              (setq index (cons new index))))))
+                       (quack-parse-srfi-subindex-file kind noninteractive))))
+            quack-srfi-subindex-kinds)
+
+    ;; Sort the parse form in reverse order, since the cache-building functions
+    ;; will reverse this.
+    (setq index (sort index (function (lambda (a b) (>= (car a) (car b))))))
+
+    ;; Build the completions and menu caches.
+    (let ((fmt (concat "%"
+                       (if index
+                           (number-to-string
+                            (length (number-to-string (car (car index)))))
+                         "")
+                       "d  %s")))
+      (mapcar (function
+               (lambda (n)
+                 (let ((num      (nth 0 n))
+                       (kind     (nth 1 n))
+                       (title    (nth 2 n)))
+                   (unless kind (quack-internal-error))
+                   (setq completes
+                         (cons (cons (if (eq kind 'final)
+                                         (format "%d  %s" num title)
+                                       (format "%d  [%s] %s" num kind title))
+                                     num)
+                               completes))
+                   (let ((pair (or (assq kind menu)
+                                   (quack-internal-error))))
+                     (setcdr pair (cons `[,(format fmt num title)
+                                          (quack-view-srfi ,num)]
+                                        (cdr pair)))))))
+              index))
+
+    ;; Finish the menu.
+    (mapcar (function (lambda (n)
+                        (setcar n (cdr (assoc (car n)
+                                              '((draft     . "Draft")
+                                                (final     . "Final")
+                                                (withdrawn . "Withdrawn")))))
+                        ;; Add dummy content so that XEmacs 21 will display
+                        ;; the submenu label.
+                        (unless (cdr n)
+                          (setcdr n (cons "(None)" nil)))))
+            menu)
+    (setq menu `(["Update SRFI Index" quack-update-srfi-index]
+                 "---"
+                 ,@menu
+                 ["Other SRFI..." quack-view-srfi]))
+
+    ;; Store the results.
+    (setq quack-srfi-menu-cache      menu)
+    (setq quack-srfi-completes-cache completes)))
+
+(defun quack-parse-srfi-subindex-file (kind &optional noninteractive)
+  (save-excursion
+    (let ((file (quack-srfi-subindex-file kind)))
+      (unless (file-exists-p file)
+        (error "No SRFI index file %S" file))
+      (let* ((buf                (get-file-buffer file))
+             (already-visiting-p buf))
+        (unless buf
+          (setq buf (find-file-noselect file t t)))
+        (unwind-protect
+            (progn (set-buffer buf)
+                   (quack-parse-srfi-subindex-buffer kind))
+          ;; unwind-protect-cleanup
+          (unless already-visiting-p
+            (kill-buffer buf)))))))
+
+(defconst quack-parse-srfi-index-buffer-re-1
+  (concat
+   "
  • SRFI[ \t]+"
+   "\\([0-9]+\\)"                       ; #=1 srfi number
+   ":?[ \t]*"
+   "\\("                                ; #<2 srfi title
+                                        ; #=3
+   (quack-re-alt "[^\r\n<>]" "")
+   "+"
+   "\\)"))
+
+(defun quack-parse-srfi-subindex-buffer (kind)
+  (save-excursion
+    (let ((case-fold-search t)
+          (alist            '()))
+      (goto-char (point-min))
+      (while (re-search-forward quack-parse-srfi-index-buffer-re-1 nil t)
+        (let ((number (string-to-number (quack-match-string-no-properties 1)))
+              (title  (quack-without-side-whitespace
+                       (quack-strip-limited-html-tags
+                        (quack-match-string-no-properties 2)))))
+          (setq alist (cons
+
+                       ;;(cons number
+                       ;;      (if (and kind (not (eq kind 'final)))
+                       ;;          (format "[%s] %s" kind title)
+                       ;;        title))
+                       (list number kind title)
+
+                       alist))))
+      (setq alist (reverse alist)))))
+
+(defun quack-srfi-num-url (num)
+  (quack-srfi-master-url (list (format "srfi-%d"      num)
+                               (format "srfi-%d.html" num))))
+
+(defconst quack-srfi-num-at-point-re-1
+  "srfi[-: \t]*\\([0-9]+\\)")
+
+(defconst quack-srfi-num-at-point-re-2
+  ;; Note: We can't have "[^\r\n]*" as a prefix, since it's too slow.
+  (concat quack-srfi-num-at-point-re-1 "[^\r\n]*"))
+
+(defun quack-srfi-num-at-point ()
+  ;; TODO: Make this get the nearest SRFI number in all cases.
+  (save-match-data
+    (let ((case-fold-search t))
+      (cond ((thing-at-point-looking-at quack-srfi-num-at-point-re-1)
+             (string-to-number (quack-match-string-no-properties 1)))
+            ((thing-at-point-looking-at "[0-9]+")
+             (string-to-number (quack-match-string-no-properties 0)))
+            ((thing-at-point-looking-at quack-srfi-num-at-point-re-2)
+             (string-to-number (quack-match-string-no-properties 1)))
+            ((let ((str (quack-line-at-point)))
+               (when (string-match quack-srfi-num-at-point-re-1 str)
+                 (string-to-number
+                  (quack-match-string-no-properties 1 str)))))))))
+
+(defun quack-view-srfi (num)
+  (interactive (list (quack-srfi-num-prompt "View SRFI number")))
+  (when num
+    (unless (and (integerp num) (>= num 0))
+      (error "Not a valid SRFI number: %S" num))
+    (quack-browse-url (quack-srfi-num-url num))))
+
+(defun quack-srfi-num-prompt (prompt)
+  (let* ((completes (quack-srfi-completes))
+         (default   (quack-srfi-num-at-point))
+         (input     (quack-without-side-whitespace
+                     (completing-read
+                      (if default
+                          (format "%s (default %d): " prompt default)
+                        (concat prompt ": "))
+                      completes)))
+         v)
+    (cond ((or (not input) (string= "" input)) default)
+          ((setq v (assoc input completes))      (cdr v))
+          ((and (setq v (condition-case nil
+                            (string-to-number input)
+                          (error nil)))
+                (integerp v)
+                (>= v 0))
+           v)
+          (t (error "Invalid SRFI number: %s" input)))))
+
+;; Doc Keyword Value Object:
+
+(defmacro quack-kw-get-syntax   (o) `(aref ,o 0))
+(defmacro quack-kw-get-file     (o) `(aref ,o 1))
+(defmacro quack-kw-get-fragment (o) `(aref ,o 2))
+
+(defmacro quack-kw-set-syntax   (o v) `(aset ,o 0 ,v))
+(defmacro quack-kw-set-file     (o v) `(aset ,o 1 ,v))
+(defmacro quack-kw-set-fragment (o v) `(aset ,o 2 ,v))
+
+;; Documentation Object:
+
+;; TODO: Rework these document representations once we know the different kinds
+;;       of documents with which we'll be dealing.
+
+(defmacro quack-doc-get-type         (o) `(aref ,o 0))
+(defmacro quack-doc-get-sym          (o) `(aref ,o 1))
+(defmacro quack-doc-get-title        (o) `(aref ,o 2))
+(defmacro quack-doc-get-loc          (o) `(aref ,o 3))
+(defmacro quack-doc-get-kw-p         (o) `(aref ,o 4))
+(defmacro quack-doc-get-start-url    (o) `(aref ,o 5))
+(defmacro quack-doc-get-kw-base-url  (o) `(aref ,o 6))
+(defmacro quack-doc-get-kw-file      (o) `(aref ,o 7))
+(defmacro quack-doc-get-kw-hashtable (o) `(aref ,o 8))
+
+(defmacro quack-doc-set-type         (o v) `(aset ,o 0 ,v))
+(defmacro quack-doc-set-sym          (o v) `(aset ,o 1 ,v))
+(defmacro quack-doc-set-title        (o v) `(aset ,o 2 ,v))
+(defmacro quack-doc-set-loc          (o v) `(aset ,o 3 ,v))
+(defmacro quack-doc-set-kw-p         (o v) `(aset ,o 4 ,v))
+(defmacro quack-doc-set-start-url    (o v) `(aset ,o 5 ,v))
+(defmacro quack-doc-set-kw-base-url  (o v) `(aset ,o 6 ,v))
+(defmacro quack-doc-set-kw-file      (o v) `(aset ,o 7 ,v))
+(defmacro quack-doc-set-kw-hashtable (o v) `(aset ,o 8 ,v))
+
+(defun quack-manual-to-doc (manual)
+  ;; Accepts a user's manual preference object of the list form:
+  ;;
+  ;;     (SYM TITLE LOC KW-P)
+  ;;
+  ;; and creates a manual doc object of the vector form:
+  ;;
+  ;;     [manual SYM TITLE LOC KW-P START-URL KW-BASE-URL KW-FILE KW-P
+  ;;      KEYWORDS]
+  ;;
+  ;; KEYWORDS is not populated here -- keywords importing for a manual happens
+  ;; the first time keyword searching is done for the manual."
+  (let ((sym       (nth 0 manual))
+        (title     (nth 1 manual))
+        (loc       (nth 2 manual))
+        (kw-p      (nth 3 manual))
+        (start-url nil)
+        (kw-file   nil)
+        (kw-base   nil))
+    (cond
+     ;; If the location is a string, then handle manual as simple URL.
+     ((stringp loc)
+      (setq start-url loc)
+      (when kw-p
+        (quack-warning "Quack can only use keywords for PLT manuals.")
+        (setq kw-p nil)))
+     ;; If the location is a symbol, handle manual as special.
+     ((symbolp loc)
+      (cond
+       ;; If the location is symbol `plt', handle manual as PLT bundled.
+       ((eq loc 'plt)
+        (let* ((plt-name (let ((s (symbol-name sym)))
+                           (if (string-match "\\`plt-\\(.+\\)\\'" s)
+                               (match-string 1 s)
+                             s)))
+               (web-base   (concat
+                           "http://download.plt-scheme.org/doc/"
+                           plt-name
+                           "/"))
+              (index-name "index.htm")
+              (col-dirs   quack-pltcollect-dirs))
+          ;; Search from the collection directories for keywords and index
+          ;; files.  Note that we currently look for keywords files even if
+          ;; `kw-p' is false since we want to allow the user to dynamically
+          ;; enable and disable keywords searching for a particular manual
+          ;; without us having to change `quack-docs'.
+          (while (and col-dirs (not (and kw-file kw-base start-url)))
+            (let ((dir (expand-file-name plt-name
+                                         (expand-file-name "doc"
+                                                           (car col-dirs)))))
+              (setq col-dirs (cdr col-dirs))
+              (when (file-directory-p dir)
+                (let* ((k-f (expand-file-name "keywords" dir))
+                       (i-f (expand-file-name index-name dir))
+                       (i-r (file-readable-p i-f)))
+                  (if (file-readable-p k-f)
+                      ;; Keywords file.
+                      (if i-r
+                          ;; Keywords file and index file.  So, unless we
+                          ;; already found a keywords base URL, set everything
+                          ;; based on this directory.  Note that we override
+                          ;; any existing start URL because we prefer to use
+                          ;; the same manual version for both keywords and
+                          ;; non-keywords access.
+                          (unless kw-base
+                            (setq kw-file   k-f)
+                            (setq kw-base   (quack-file-url dir nil))
+                            (setq start-url (quack-file-url dir index-name)))
+                        ;; Keywords file, but no index file.  So, unless we
+                        ;; already have a keywords file, set it to this one.
+                        (unless kw-file
+                          (setq kw-file k-f)))
+                    ;; No keywords file.  So, if there is an index file, and we
+                    ;; don't already have one, then use this one.
+                    (when (and i-r (not start-url))
+                      (setq start-url (quack-file-url dir index-name))))))))
+          ;; If we didn't find a start URL, use the Web one.
+          (unless start-url
+            (setq start-url (concat web-base index-name)))
+          ;; Do we have a keywords file?
+          (if kw-file
+              ;; We have a keywords file, so set the keywords base to the Web
+              ;; if needed and desired.  Note that we never use the keywords
+              ;; file from one directory with the HTML files from a different
+              ;; directory, on the assumption that a local copy of HTML missing
+              ;; a keywords file is suspect, and that the Web version is
+              ;; therefore preferable.
+              (when (or (eq quack-local-keywords-for-remote-manuals-p 'always)
+                        (and (not kw-base)
+                             quack-local-keywords-for-remote-manuals-p))
+                (setq kw-base web-base))
+            ;; We don't have a keywords file, so warn if the user wanted
+            ;; keywords for this manual.
+            (when kw-p
+              (quack-warning "Could not find keywords file for manual %S."
+                             plt-name)))))
+       ;; The location is an unrecognized symbol, so just barf.
+       (t (quack-internal-error))))
+     ;; The location is something other than a string or symbol, so just barf.
+     (t (quack-internal-error)))
+    ;; We've populated all the variables for the location type, so return the
+    ;; representation.
+    (vector 'manual sym title loc kw-p start-url kw-base kw-file nil)))
+
+(defun quack-doc-keyword-lookup (doc keyword)
+  (let ((ht (or (quack-doc-get-kw-hashtable doc)
+                (progn (quack-doc-import-keywords doc)
+                       (quack-doc-get-kw-hashtable doc)))))
+    (if ht
+        (quack-gethash keyword ht nil)
+      (quack-warning "No keywords for document \"%S\"."
+                     (quack-doc-get-sym doc))
+      nil)))
+
+(defun quack-doc-import-keywords (doc)
+  (if (eq (quack-doc-get-loc doc) 'plt)
+      (quack-doc-import-plt-manual-keywords doc)
+    (quack-internal-error)))
+
+(defun quack-doc-import-plt-manual-keywords (doc)
+  ;; Reads in the predetermined keywords file for PLT manual `doc' object,
+  ;; populating the `kw-hashtable' field of the `doc' object.  The format of
+  ;; each entry in the PLT keywords file is a list of 5 strings:
+  ;;
+  ;;     (KEYWORD SYNTAX FILE FRAGMENT SECTION)
+  ;;
+  ;; The hashtable is keyed on the KEYWORD string, for which the value is
+  ;; usually a vector:
+  ;;
+  ;;     [SYNTAX FILE-CONST FRAGMENT]
+  ;;
+  ;; where FILE-CONST is the FILE string registered with the `quack-strconst'
+  ;; to save memory on redundant strings.
+  ;;
+  ;; When more there is more than one entry for a given keyword, then the value
+  ;; of the hashtable entry for that keyword is a list of vectors, in the order
+  ;; in which they were derived from the original keywords file.
+  ;;
+  ;; These duplicate values may be duplicated or conflicting, as in:
+  ;;
+  ;;     (["(regexp-match pattern input-port [start-k end-k output-port])"
+  ;;       "mzscheme-Z-H-10.html" "%_kw_definitionregexp-match"]
+  ;;      ["(regexp-match pattern string [start-k end-k output-port])"
+  ;;       "mzscheme-Z-H-10.html" "%_kw_definitionregexp-match"])
+  ;;
+  ;; No attempt is made here to weed out any duplicate/conflicting entries --
+  ;; that behavior left up to the code that accesses the hashtable.  For the
+  ;; example above, a command to display the syntax for the keyword would need
+  ;; to display both values.  However, a command to view the documentation for
+  ;; the keyword would need only to display one Web page without querying the
+  ;; user, since both entries above point to the same page and fragment.
+  (quack-activity
+   (format "Importing keywords for manual %S" (quack-doc-get-sym doc))
+   (let (sexp)
+     (garbage-collect)
+     (condition-case err
+         (setq sexp (quack-read-sexp-file
+                     (or (quack-doc-get-kw-file doc)
+                         (quack-warning "Manual %S has no keywords file."
+                                        (quack-doc-get-sym doc)))))
+       (error (quack-warning "Problem importing keywords for manual %S: %s"
+                             (quack-doc-get-sym doc) err)))
+     (when sexp
+       (garbage-collect)
+       (let ((ht (quack-make-hash-table :test             'equal
+                                        :size             (length sexp)
+                                        :rehash-threshold 1.0)))
+         ;; Note: We make the hashtable equal to the length of the read list of
+         ;; keyword forms so that it will be at least large enough for all the
+         ;; keywords without being excessively overlarge, and without having to
+         ;; do resizes or a counting pass or intermediate representation.  The
+         ;; hashtable will be a little larger than necessary when there are
+         ;; multiple keyword forms for the same keyword.  In a test with
+         ;; MzScheme 200.2, the hashtable used/size for "mzscheme" manual was
+         ;; 489/502; for "mzlib", 245/257.
+         (quack-doc-set-kw-hashtable doc ht)
+         (mapcar (function
+                  (lambda (raw-entry)
+                    (let* ((kw  (nth 0 raw-entry))
+                           (new (vector (nth 1 raw-entry)
+                                        (quack-strconst (nth 2 raw-entry))
+                                        (nth 3 raw-entry)))
+                           (old (quack-gethash kw ht nil)))
+                      (quack-puthash
+                       kw
+                       (cond ((not     old) new)
+                             ((vectorp old) (list  old new))
+                             ((listp   old) (nconc old (list new))))
+                       ht))))
+                 sexp))))))
+
+(defun quack-read-sexp-file (filename)
+  (save-excursion
+    (let* ((buf (generate-new-buffer "*quack-read-sexp-file*")))
+      (set-buffer buf)
+      (unwind-protect
+          (progn (insert-file-contents-literally filename)
+                 (goto-char (point-min))
+                 (read buf))
+        ;; unwind-protect cleanup
+        (kill-buffer buf)))))
+
+;; Documentation Database:
+
+(defvar quack-docs 'invalid)
+
+(defun quack-docs ()
+  (when (eq quack-docs 'invalid)
+    (quack-docs-build))
+  quack-docs)
+
+(defun quack-docs-build ()
+  (quack-activity
+   "Building Quack docs database"
+   (quack-invalidate-manuals-caches)
+   (setq quack-docs (mapcar 'quack-manual-to-doc quack-manuals))))
+
+(defun quack-docs-manual-lookup (sym)
+  (let ((docs  (quack-docs))
+        (found nil))
+    (while (and docs (not found))
+      (let ((doc (car docs)))
+        (setq docs (cdr docs))
+        (when (eq (quack-doc-get-sym doc) sym)
+          (setq found doc))))
+    found))
+
+(defun quack-docs-manual-keyword-lookup (keyword)
+  (let ((results '()))
+    (mapcar (function
+             (lambda (doc)
+               (cond
+                ((not (quack-doc-get-kw-p doc)) nil)
+                ((not (quack-doc-get-kw-base-url doc))
+                 (quack-warning "Manual %S has no HTML."
+                                (quack-doc-get-sym doc)))
+                (t (let ((match (quack-doc-keyword-lookup doc keyword)))
+                     (cond
+                      ((not match) nil)
+                      ((vectorp match)
+                       (setq results (cons (cons doc match) results)))
+                      ((listp match)
+                       (mapcar (function
+                                (lambda (m)
+                                  (setq results (cons (cons doc m) results))))
+                               match))
+                      (t (quack-internal-error))))))))
+            (quack-docs))
+    (reverse results)))
+
+;; Keyword Lookup Match Object:
+
+(defmacro quack-kwmatch-get-doc (o) `(car ,o))
+(defmacro quack-kwmatch-get-kw  (o) `(cdr ,o))
+
+(defun quack-kwmatch-url (kwmatch)
+  (let ((doc (car kwmatch))
+        (kw  (cdr kwmatch)))
+    (concat (quack-doc-get-kw-base-url doc)
+            (quack-quote-url-substring (quack-kw-get-file kw))
+            "#"
+            (quack-quote-url-substring (quack-kw-get-fragment kw) t))))
+
+;; Manual Viewing:
+
+(defun quack-view-manual (&optional sym)
+  "View a manual."
+  (interactive
+   (list
+    (let* ((completes (or (quack-manuals-completes)
+                          (error
+                           "Sorry, variable \"quack-manuals\" is empty.")))
+           (default   "R5RS")
+           (input     (let ((completion-ignore-case t))
+                        (completing-read
+                         (format "Quack Manual (default %S): " default)
+                         completes nil t nil nil default))))
+      (cdr (or (assoc input completes)
+               (error "No manual %S." input))))))
+  (quack-activity
+   (format "Viewing manual \"%S\"" sym)
+   (quack-browse-url (or (quack-doc-get-start-url
+                          (or (quack-docs-manual-lookup sym)
+                              (error "Manual \"%S\" not found." sym)))
+                         (error "Don't know a URL for manual \"%S\"." sym)))))
+
+(defvar quack-manuals-menu-cache      'invalid)
+(defvar quack-manuals-completes-cache 'invalid)
+
+(defun quack-invalidate-manuals-caches ()
+  (setq quack-docs                    'invalid)
+  (setq quack-manuals-completes-cache 'invalid)
+  (setq quack-manuals-menu-cache      'invalid))
+
+;;(quack-invalidate-manuals-caches)
+
+;; This version maps completion strings to URLs.
+;; (defun quack-manuals-completes ()
+;;   (when (eq quack-manuals-completes-cache 'invalid)
+;;     (let ((completes '()))
+;;       (mapcar (function
+;;                (lambda (doc)
+;;                  (let ((sym (quack-doc-get-sym doc))
+;;                        (url (quack-doc-get-start-url doc)))
+;;                    (setq completes
+;;                          (cons (cons (quack-doc-get-title doc) url)
+;;                                (cons (cons (symbol-name sym) url)
+;;                                      completes))))))
+;;               (quack-docs))
+;;       (setq quack-manuals-completes-cache (reverse completes))))
+;;   quack-manuals-completes-cache)
+
+(defun quack-manuals-completes ()
+  (when (eq quack-manuals-completes-cache 'invalid)
+    (let ((completes '()))
+      (mapcar (function
+               (lambda (doc)
+                 (let ((sym (quack-doc-get-sym doc))
+                       ;;(url (quack-doc-get-start-url doc))
+                       )
+                   (setq completes
+                         (cons (cons (quack-doc-get-title doc) sym)
+                               ;;(cons (cons (symbol-name sym) sym)
+                                     completes
+                                     ;;)
+                                     )))))
+              (quack-docs))
+      (setq quack-manuals-completes-cache (reverse completes))))
+  quack-manuals-completes-cache)
+
+(defun quack-manuals-menu ()
+  (when (eq quack-manuals-menu-cache 'invalid)
+    (setq quack-manuals-menu-cache
+          (mapcar (function
+                   (lambda (manual)
+                     (let ((sym   (nth 0 manual))
+                           (title (nth 1 manual)))
+                       `[,title (quack-view-manual (quote ,sym))])))
+                  quack-manuals)))
+  quack-manuals-menu-cache)
+
+(defun quack-manuals-webjump-sites ()
+  "Returns `webjump' entries for manuals in `quack-manuals'.
+
+Can be used in your `~/.emacs' file something like this:
+
+    (require 'quack)
+    (require 'webjump)
+    (require 'webjump-plus)
+    (setq webjump-sites
+          (append my-own-manually-maintained-webjump-sites
+                  (quack-manuals-webjump-sites)
+                  webjump-plus-sites
+                  webjump-sample-sites))"
+  ;; TODO: Note what they should do if they are adding to plt collectsion dirs
+  ;;       via custom settings but quack-manuals-webjump-sites is getting
+  ;;       called before then.
+  (let ((result                 '())
+        (quack-quiet-warnings-p t))
+    (mapcar (function
+             (lambda (doc)
+               (let ((url (quack-doc-get-start-url doc)))
+                 (when url
+                   (setq result (cons (cons (quack-doc-get-title doc) url)
+                                      result))))))
+            (quack-docs))
+    result))
+
+;; Keyword Docs Viewing:
+
+;; TODO: Add doc lookup in PLT "doc.txt" files.  A little tricky.  Maybe make
+;;       sure doc.txt is a long-term format first.
+
+(defun quack-view-keyword-docs (keyword)
+  ;; TODO: Don't prompt if all choices would result in the same URL.
+  (interactive (list (quack-prompt-for-keyword "View docs for keyword")))
+  (when (and keyword (stringp keyword) (not (string= keyword "")))
+    (let ((matches (quack-docs-manual-keyword-lookup keyword)))
+      (if (not matches)
+          (message "Sorry, no documentation found for keyword %S." keyword)
+        (quack-browse-url
+         (quack-kwmatch-url
+          (if (cdr matches)
+              (quack-prompt-for-kwmatch-choice "Which" matches)
+            (car matches))))))))
+
+(defun quack-keyword-at-point ()
+  ;; TODO: Make sure this reads all Scheme symbols -- it may currently only
+  ;;       read valid Elisp symbols.
+  (let ((bounds (bounds-of-thing-at-point 'symbol)))
+    ;; In some cases (point at beginning of empty buffer?), `bounds' will be
+    ;; the bounds of an empty string, so check this.
+    (when bounds
+      (let ((beg (car bounds))
+            (end (cdr bounds)))
+        (when (/= beg end)
+          (buffer-substring-no-properties beg end))))))
+
+(defun quack-prompt-for-keyword (prompt)
+  (let* ((default (quack-keyword-at-point))
+         (history (list default)))
+    (read-string (if default
+                     (format "%s (default %S): " prompt default)
+                   (concat prompt ": "))
+                 nil
+                 ;; Note: Gratuitous reference to `history' eliminates warning
+                 ;;       from XEmacs 21 byte-compiler.
+                 (if (and default history) 'history nil)
+                 default)))
+
+(defun quack-prompt-for-kwmatch-choice (prompt kwmatch-list)
+  (let ((completes '()))
+    ;; Build the completion alist, ensure each key is unique.
+    (mapcar
+     (function
+      (lambda (kwmatch)
+        (let* ((kw         (quack-kwmatch-get-kw kwmatch))
+               (orig-name  (or (quack-kw-get-syntax kw)
+                               (progn (quack-warning "No keyword syntax: %s"
+                                                     kw)
+                                      "???")))
+               (name       orig-name)
+               (name-tries 1))
+          ;; Ensure the name is unique within the completion list thus far.
+          (while (assoc name completes)
+            (setq name-tries (1+ name-tries))
+            (setq name (format "%s #%d" orig-name name-tries)))
+          ;; Prepend to the completion list (we'll reverse the list later).
+          (setq completes (cons (cons name kwmatch) completes)))))
+     kwmatch-list)
+    (setq completes (reverse completes))
+    ;; Prompt user and return selection.
+    (let* ((default (car (car completes)))
+           (read    (let ((completion-ignore-case t))
+                      (completing-read
+                       (format "%s (default %S): " prompt default)
+                       completes nil t nil nil default))))
+      (cdr (assoc read completes)))))
+
+;; Inferior Process:
+
+(defvar quack-run-scheme-prompt-history '())
+
+(defun quack-remember-program-maybe (program)
+  (when (and quack-remember-new-programs-p
+             (not (member program quack-programs)))
+    (quack-option-set 'quack-programs (cons program quack-programs) t)
+    (message "Remembering program %S." program)))
+
+(defun quack-run-scheme-prompt ()
+  (let* ((last    (car quack-run-scheme-prompt-history))
+         (default (or (and quack-run-scheme-prompt-defaults-to-last-p
+                           last)
+                      quack-default-program
+                      scheme-program-name
+                      last
+                      "mzscheme"))
+         (program (let ((minibuffer-allow-text-properties nil))
+                    (completing-read
+                     (concat "Run Scheme"
+                             (if default
+                                 (format " (default %S)" default)
+                               "")
+                             ": ")
+                     (quack-run-scheme-prompt-completion-collection)
+                     nil nil nil
+                     'quack-run-scheme-prompt-history
+                     default))))
+    (quack-remember-program-maybe program)
+    program))
+
+(defun quack-run-scheme-prompt-completion-collection ()
+  (let ((program-list quack-programs))
+    (mapcar (function (lambda (program)
+                        (and program
+                             (not (member program program-list))
+                             (setq program-list (cons program program-list)))))
+            (list quack-default-program
+                  scheme-program-name))
+    (mapcar (function (lambda (program) (cons program nil)))
+            program-list)))
+
+(defadvice run-scheme (around quack-ad-run first nil activate)
+  "Adds prompting for which Scheme interpreter program to run."
+  ;; We don't want to prompt if there's already a Scheme running, but it's
+  ;; possible for process to die between the comint check in `interactive' form
+  ;; of this advice and the comint check in the `run-scheme' function.  We
+  ;; should override `run-scheme' altogether, but for now let's only call the
+  ;; original in the case that we do not detect a running Scheme.
+  (interactive (list (cond ((comint-check-proc "*scheme*") nil)
+                           ((or current-prefix-arg
+                                quack-run-scheme-always-prompts-p)
+                            (quack-run-scheme-prompt))
+                           (t quack-default-program))))
+  (if cmd
+      ;; We will assume there is no running Scheme, so...  Since `run-scheme'
+      ;; calls `pop-to-buffer' rather than `switch-to-scheme', our options for
+      ;; Scheme process window management, such as putting the process buffer
+      ;; window in its own frame, do not take effect when the process buffer is
+      ;; displayed by `run-scheme'.  So, unless we are using the `cmuscheme'
+      ;; window management behavior, we attempt to undo whatever window changes
+      ;; and buffer changes `run-scheme' makes, then just call
+      ;; `switch-to-scheme'.  (This code will be revisited once we decide how
+      ;; to handle multiple Schemes, if not before then.)
+      (let ((buf (current-buffer))
+            (wg  (current-window-configuration)))
+        ad-do-it
+        (unless (or (not quack-switch-to-scheme-method)
+                    (eq quack-switch-to-scheme-method 'cmuscheme))
+          (set-window-configuration wg)
+          (set-buffer buf)
+          (switch-to-scheme t))
+        (message "Started Scheme: %s" scheme-program-name))
+    ;; There is a running Scheme, so don't call the `run-scheme' function at
+    ;; all -- just call `switch-to-scheme' or duplicate the `cmuscheme'
+    ;; package's `pop-to-buffer' behavior.
+    (if (or (not quack-switch-to-scheme-method)
+            (eq quack-switch-to-scheme-method 'cmuscheme))
+        (pop-to-buffer "*scheme*")
+      (switch-to-scheme t))
+    (message "Switched to running Scheme: %s" scheme-program-name)))
+
+(defadvice scheme-interactively-start-process (around
+                                               quack-ad-sisp 
+                                               first
+                                               (&optional cmd)
+                                               activate)
+  ;; (save-window-excursion
+  (call-interactively 'run-scheme)
+  ;; )
+  )
+
+(defadvice scheme-proc (around quack-ad-scheme-proc first nil activate)
+  (condition-case nil
+      ad-do-it
+    (error (message "Oops, we must start a Scheme process!")
+           (call-interactively 'run-scheme)
+           (setq ad-return-value (scheme-proc)))))
+
+;; Switch-to-Scheme:
+
+(defun quack-force-frame-switch-to-window (win)
+  (let ((frame (window-frame win)))
+    (unless (eq frame (selected-frame))
+      (and window-system
+           quack-warp-pointer-to-frame-p
+           (set-mouse-position frame 0 0))
+      (select-frame frame))
+    (select-window win)))
+
+(defadvice switch-to-scheme (before quack-ad-switch last nil activate)
+  "Adds support for the `quack-switch-to-scheme-method' option."
+  ;; This can be done as before-advice since the `pop-to-buffer' that
+  ;; `switch-to-scheme' is using appears to always be a no-op when the target
+  ;; buffer is already the current buffer.
+  (require 'cmuscheme)
+  ;; The `eval' below is to avoid problems with the byte-compiler and advising.
+  ;; It doesn't seem to like: (and (boundp 'SYM) SYM)
+  (let ((repl-buf (eval '(and (boundp 'scheme-buffer)
+                              scheme-buffer
+                              (get-buffer scheme-buffer)))))
+    (cond ((not repl-buf)
+           (error (concat "No process current buffer."
+                          " Set `scheme-buffer' or execute `run-scheme'")))
+
+          ((or (not quack-switch-to-scheme-method)
+               (eq quack-switch-to-scheme-method 'cmuscheme))
+           nil)
+
+          ((eq (current-buffer) repl-buf) nil)
+
+          ((eq quack-switch-to-scheme-method 'other-window)
+           (switch-to-buffer-other-window repl-buf))
+
+          ;; The following code may be revived if anyone reports problems with
+          ;; the use of `special-display-popup-frame'.
+          ;;
+          ;; ((eq quack-switch-to-scheme-method 'own-frame)
+          ;;  (let ((pop-up-frames                t)
+          ;;        (same-window-buffer-names     nil)
+          ;;        (same-window-regexps          nil)
+          ;;        (special-display-buffer-names nil)
+          ;;        (special-display-regexps      nil))
+          ;;    (switch-to-buffer (pop-to-buffer repl-buf))))
+
+          ((eq quack-switch-to-scheme-method 'own-frame)
+           (quack-force-frame-switch-to-window
+            (special-display-popup-frame repl-buf)))
+
+          (t (error "Invalid quack-switch-to-scheme-method: %S"
+                    quack-switch-to-scheme-method)))))
+
+;; Customize:
+
+(defun quack-customize ()
+  "Customize the Quack package."
+  (interactive)
+  (customize-group 'quack))
+
+;; Auto Modes:
+
+(defun quack-add-auto-mode-alist (alist)
+  (setq auto-mode-alist
+        (append alist
+                (let ((retained '()))
+                  (mapcar (function (lambda (pair)
+                                      (unless (assoc (car pair) alist)
+                                        (setq retained (cons pair retained)))))
+                          auto-mode-alist)
+                  (reverse retained)))))
+
+(quack-add-auto-mode-alist '(("\\.ccl\\'"    . scheme-mode)
+                             ("\\.rkt\\'"    . scheme-mode)
+                             ("\\.rktd\\'"   . scheme-mode)
+                             ("\\.sch\\'"    . scheme-mode)
+                             ("\\.scm\\'"    . scheme-mode)
+                             ("\\.ss\\'"     . scheme-mode)
+                             ("\\.stk\\'"    . scheme-mode)
+                             ("\\.stklos\\'" . scheme-mode)
+                             ;;
+                             ("/\\.mzschemerc\\'" . scheme-mode)
+                             ;; Non-Scheme:
+                             ("\\.plt\\'"    . quack-pltfile-mode)))
+
+;; Syntax Table:
+
+(defmacro quack-str-syntax (str)
+  `(,(if (and quack-gnuemacs-p (>= emacs-major-version 21))
+         'string-to-syntax
+       'quack-kludged-string-to-syntax)
+    ,str))
+
+(defun quack-kludged-string-to-syntax (str)
+  (let* ((str-len (length str))
+         (code    (aref str 0))
+         (matches (if (> str-len 1) (aref str 1)))
+         (result  (cond ((= code 32) 0)
+                        ((= code ?_) 3)
+                        (t (quack-internal-error))))
+         (i       2))
+    (while (< i str-len)
+      (let ((c (aref str i)))
+        (setq i (1+ i))
+        (setq result (logior result
+                             (lsh 1 (cond ((= c ?1) 16)
+                                          ((= c ?2) 17)
+                                          ((= c ?3) 18)
+                                          ((= c ?4) 19)
+                                          ((= c ?p) 20)
+                                          ((= c ?b) 21)
+                                          ((= c ?n) 21)
+                                          (t (quack-internal-error))))))))
+    (cons result (if (= matches 32) nil matches))))
+
+;; Note: We are assuming that it is better to endeavor to fontify all "#|"
+;;       block comments as nestable rather than as unnestable, regardless of
+;;       whether or not a user's target Scheme dialect supports nested.
+
+(defconst quack-pound-syntax-string (if quack-gnuemacs-p "_ p14bn" "_ p14b"))
+;; (defconst quack-bar-syntax-string   (if quack-gnuemacs-p "  23bn"  "  23b"))
+(defconst quack-bar-syntax-string   (if quack-gnuemacs-p "_ 23bn"  "_ 23b"))
+
+(defconst quack-pound-syntax (quack-str-syntax quack-pound-syntax-string))
+(defconst quack-bar-syntax   (quack-str-syntax quack-bar-syntax-string))
+
+(modify-syntax-entry ?# quack-pound-syntax-string scheme-mode-syntax-table)
+(modify-syntax-entry ?| quack-bar-syntax-string   scheme-mode-syntax-table)
+
+;; Note: Unclear why, but `scheme.el' in GNU Emacs 21.2 is doing
+;;       `(set-syntax-table scheme-mode-syntax-table)' in whatever buffer is
+;;       active at the time the Elisp package is loaded.
+
+;; Indent Properties:
+
+(put 'begin0                 'scheme-indent-function 1)
+(put 'c-declare              'scheme-indent-function 0)
+(put 'c-lambda               'scheme-indent-function 2)
+(put 'call-with-input-file   'scheme-indent-function 1)
+(put 'call-with-input-file*  'scheme-indent-function 1)
+(put 'call-with-output-file  'scheme-indent-function 1)
+(put 'call-with-output-file* 'scheme-indent-function 1)
+(put 'call-with-semaphore    'scheme-indent-function 1)
+(put 'case-lambda            'scheme-indent-function 0)
+(put 'catch                  'scheme-indent-function 1)
+(put 'chicken-setup          'scheme-indent-function 1)
+(put 'class                  'scheme-indent-function 'defun)
+(put 'class*                 'scheme-indent-function 'defun)
+(put 'compound-unit/sig      'scheme-indent-function 0)
+(put 'defboolparam           'scheme-indent-function 2)
+(put 'defform                'scheme-indent-function 1)
+(put 'defform*               'scheme-indent-function 1)
+(put 'defform*/subs          'scheme-indent-function 2)
+(put 'defform/none           'scheme-indent-function 1)
+(put 'defform/subs           'scheme-indent-function 2)
+(put 'defidform              'scheme-indent-function 1)
+(put 'define-runtime-path    'scheme-indent-function 1)
+(put 'define-sequence-id     'scheme-indent-function 1)
+(put 'define:                'scheme-indent-function 3)
+(put 'defparam               'scheme-indent-function 3)
+(put 'defproc                'scheme-indent-function 2)
+(put 'defproc*               'scheme-indent-function 1)
+(put 'defstruct              'scheme-indent-function 2)
+(put 'defstruct*             'scheme-indent-function 2)
+(put 'defthing               'scheme-indent-function 2)
+(put 'deftogether            'scheme-indent-function 1)
+(put 'do                     'scheme-indent-function 2)
+(put 'dynamic-wind           'scheme-indent-function 0)
+(put 'filebox                'scheme-indent-function 1)
+(put 'for                    'scheme-indent-function 1)
+(put 'for*                   'scheme-indent-function 1)
+(put 'for*/and               'scheme-indent-function 1)
+(put 'for*/first             'scheme-indent-function 1)
+(put 'for*/fold              'scheme-indent-function 2)
+(put 'for*/fold/derived      'scheme-indent-function 3)
+(put 'for*/hash              'scheme-indent-function 1)
+(put 'for*/hasheq            'scheme-indent-function 1)
+(put 'for*/hasheqv           'scheme-indent-function 1)
+(put 'for*/last              'scheme-indent-function 1)
+(put 'for*/list              'scheme-indent-function 1)
+(put 'for*/lists             'scheme-indent-function 2)
+(put 'for*/or                'scheme-indent-function 1)
+(put 'for*/product           'scheme-indent-function 1)
+(put 'for*/sum               'scheme-indent-function 1)
+(put 'for*/vector            'scheme-indent-function 1)
+(put 'for*/vector            'scheme-indent-function 1)
+(put 'for/and                'scheme-indent-function 1)
+(put 'for/first              'scheme-indent-function 1)
+(put 'for/fold               'scheme-indent-function 2)
+(put 'for/fold               'scheme-indent-function 2)
+(put 'for/fold/derived       'scheme-indent-function 3)
+(put 'for/hash               'scheme-indent-function 1)
+(put 'for/hasheq             'scheme-indent-function 1)
+(put 'for/hasheqv            'scheme-indent-function 1)
+(put 'for/last               'scheme-indent-function 1)
+(put 'for/list               'scheme-indent-function 1)
+(put 'for/lists              'scheme-indent-function 2)
+(put 'for/or                 'scheme-indent-function 1)
+(put 'for/product            'scheme-indent-function 1)
+(put 'for/sum                'scheme-indent-function 1)
+(put 'for/vector             'scheme-indent-function 1)
+(put 'instantiate            'scheme-indent-function 2)
+(put 'interface              'scheme-indent-function 1)
+(put 'lambda/kw              'scheme-indent-function 1)
+(put 'let*-values            'scheme-indent-function 1)
+(put 'let*:                  'scheme-indent-function 'quack-let-colon-indent)
+(put 'let+                   'scheme-indent-function 1)
+(put 'let-values             'scheme-indent-function 1)
+(put 'let/ec                 'scheme-indent-function 1)
+(put 'let:                   'scheme-indent-function 'quack-let-colon-indent)
+(put 'letrec-values          'scheme-indent-function 1)
+(put 'match                  'scheme-indent-function 1)
+(put 'match-let              'scheme-indent-function 1)
+(put 'mixin                  'scheme-indent-function 2)
+(put 'module                 'scheme-indent-function 'defun)
+(put 'module                 'scheme-indent-function 2)
+(put 'module*                'scheme-indent-function 2)
+(put 'module+                'scheme-indent-function 1)
+(put 'opt-lambda             'scheme-indent-function 1)
+(put 'parameterize           'scheme-indent-function 1)
+(put 'parameterize*          'scheme-indent-function 1)
+(put 'parameterize-break     'scheme-indent-function 1)
+(put 'quasisyntax/loc        'scheme-indent-function 1)
+(put 'receive                'scheme-indent-function 2)
+(put 'send*                  'scheme-indent-function 1)
+(put 'sigaction              'scheme-indent-function 1)
+(put 'specform               'scheme-indent-function 1)
+(put 'specspecsubform        'scheme-indent-function 1)
+(put 'specspecsubform/subs   'scheme-indent-function 2)
+(put 'specsubform            'scheme-indent-function 1)
+(put 'specsubform/subs       'scheme-indent-function 2)
+(put 'struct                 'scheme-indent-function 1)
+(put 'sxml-match             'scheme-indent-function 1)
+(put 'syntax-case            'scheme-indent-function 2)
+(put 'syntax-parse           'scheme-indent-function 1)
+(put 'syntax/loc             'scheme-indent-function 1)
+(put 'test-section           'scheme-indent-function 1)
+(put 'unit                   'scheme-indent-function 'defun)
+(put 'unit/sig               'scheme-indent-function 2)
+(put 'unless                 'scheme-indent-function 1)
+(put 'when                   'scheme-indent-function 1)
+(put 'while                  'scheme-indent-function 1)
+(put 'with-handlers          'scheme-indent-function 1)
+(put 'with-handlers*         'scheme-indent-function 1)
+(put 'with-method            'scheme-indent-function 1)
+(put 'with-syntax            'scheme-indent-function 1)
+
+(defun quack-let-colon-indent (state indent-point normal-indent)
+  ;; Note: This was adapted from "scheme.el" "scheme-let-indent".
+  (skip-chars-forward " \t")
+  (if (looking-at "[-a-zA-Z0-9+*/?!@$%^&_:~]")
+      (lisp-indent-specform 4 state indent-point normal-indent)
+    (lisp-indent-specform 1 state indent-point normal-indent)))
+
+;; Keymaps:
+
+(defvar quack-scheme-mode-keymap nil)
+
+(setq quack-scheme-mode-keymap (make-sparse-keymap))
+
+;; TODO: Maybe have an option to also map the Ctrl variants of each of these
+;;       keys to their respective bindings.  As Eli pointed out, `C-c C-q C-x'
+;;       is arguably easier to type than `C-c C-q x'.  Actually, though, I
+;;       don't like the `C-c C-q' prefix at all -- it signifies everything that
+;;       is wrong with traditional modifier-happy Emacs keybindings.  Maybe we
+;;       should encourage users to set the prefix to some other key, like an
+;;       unmodified function key.
+
+(define-key quack-scheme-mode-keymap "f" 'quack-find-file)
+(define-key quack-scheme-mode-keymap "k" 'quack-view-keyword-docs)
+(define-key quack-scheme-mode-keymap "m" 'quack-view-manual)
+(define-key quack-scheme-mode-keymap "r" 'run-scheme)
+(define-key quack-scheme-mode-keymap "s" 'quack-view-srfi)
+(define-key quack-scheme-mode-keymap "l" 'quack-toggle-lambda)
+(define-key quack-scheme-mode-keymap "t" 'quack-tidy-buffer)
+
+;; Menus:
+
+(defmacro quack-bool-menuitem (title var &rest rest)
+  (unless (stringp title) (quack-internal-error))
+  (unless (symbolp var)   (quack-internal-error))
+  `[,title (quack-option-toggle (quote ,var)) :style toggle :selected ,var
+           ,@rest])
+
+(defmacro quack-radio-menuitems (var alist)
+  (unless (symbolp var)   (quack-internal-error))
+  (unless (listp   alist) (quack-internal-error))
+  `(quote ,(mapcar
+            (function (lambda (pair)
+                        (let ((title (car pair))
+                              (value (cdr pair)))
+                          (unless (stringp title) (quack-internal-error))
+                          (unless (symbolp value) (quack-internal-error))
+                          `[,title
+                            (quack-option-set (quote ,var) (quote ,value))
+                            :style    radio
+                            :selected (eq ,var (quote ,value))])))
+            alist)))
+
+(defconst quack-browser-radio-alist
+  '((nil                                . "(Browse-URL Default)")
+    (browse-url-galeon                  . "Galeon")
+    (browse-url-mozilla                 . "Mozilla")
+    (browse-url-kde                     . "KDE Konqueror")
+    (browse-url-netscape                . "Netscape Navigator")
+    (browse-url-w3                      . "Emacs W3")
+    (w3m-browse-url                     . "W3M")
+    (quack-w3m-browse-url-other-window  . "W3M (in other window)")
+    (browse-url-lynx-xterm              . "Lynx in Xterm")
+    (browse-url-lynx-emacs              . "Lynx in Emacs")
+    (browse-url-default-windows-browser . "MS Windows Default")))
+
+(defconst quack-global-menuspec
+  `("Quack"
+    ["About Quack..." quack-about]
+    ("Options"
+     ("Startup Options"
+      "These settings take full effect"
+      "once Emacs is restarted."
+      "---"
+      ,(quack-bool-menuitem "Put Quack on Global Menu Bar" quack-global-menu-p)
+      ,(quack-bool-menuitem "Remap Find-File Bindings"
+                            quack-remap-find-file-bindings-p)
+      "---"
+      ["Quack Directory..." (customize-option 'quack-dir)]
+      ["Quack Scheme Mode Keymap Prefix..."
+       (customize-option 'quack-scheme-mode-keymap-prefix)])
+     "---"
+     ("Default Program" :filter quack-defaultprogram-menufilter)
+     ,(quack-bool-menuitem "Always Prompt for Program"
+                           quack-run-scheme-always-prompts-p)
+     ,(quack-bool-menuitem "Program Prompt Defaults to Last"
+                           quack-run-scheme-prompt-defaults-to-last-p)
+     ,(quack-bool-menuitem "Remember New Programs"
+                           quack-remember-new-programs-p)
+     "---"
+     ("Newline Behavior"
+      ,@(quack-radio-menuitems
+         quack-newline-behavior
+         (("Newline"               . newline)
+          ("Newline-Indent"        . newline-indent)
+          ("Indent-Newline-Indent" . indent-newline-indent))))
+     ,(quack-bool-menuitem "Smart Open-Paren"
+                           quack-smart-open-paren-p)
+     ("Switch-to-Scheme Method"
+      ,@(quack-radio-menuitems quack-switch-to-scheme-method
+                               (("Other Window"       . other-window)
+                                ("Own Frame"          . own-frame)
+                                ("Cmuscheme Behavior" . cmuscheme)))
+      "---"
+      ,(quack-bool-menuitem
+        "Warp Pointer to Frame"
+        quack-warp-pointer-to-frame-p
+        :active (eq quack-switch-to-scheme-method 'own-frame)))
+     ("Fontification"
+      ,@(quack-radio-menuitems quack-fontify-style
+                               (("PLT Style"                . plt)
+                                ("Extended GNU Emacs Style" . emacs)
+                                ("Emacs Default"            . nil)))
+      "---"
+      ,(quack-bool-menuitem "Pretty Lambda \(in PLT Style\)"
+                            quack-pretty-lambda-p
+                            :active (and quack-pretty-lambda-supported-p
+                                         (memq quack-fontify-style '(plt))))
+      ,(quack-bool-menuitem "Fontify Definition Names \(in PLT Style\)"
+                            quack-pltish-fontify-definition-names-p
+                            :active (eq quack-fontify-style 'plt))
+      ,(quack-bool-menuitem "Fontify Syntax Keywords \(in PLT Style\)"
+                            quack-pltish-fontify-keywords-p
+                            :active (eq quack-fontify-style 'plt))
+      ;; TODO: Add menuitem here for "Fontify #: Keywords \(in PLT Style\)"
+      ,(quack-bool-menuitem "Fontify 3-Semicolon Comments \(in PLT Style\)"
+                            quack-fontify-threesemi-p
+                            :active (memq quack-fontify-style '(plt)))
+      )
+     ("Web Browser"
+      ,@(mapcar (function
+                 (lambda (n)
+                   (let ((func  (car n))
+                         (title (cdr n)))
+                     `[,title
+                       (quack-option-set 'quack-browse-url-browser-function
+                                         (quote ,func))
+                       :style radio
+                       :selected ,(if (not func)
+                                      '(not quack-browse-url-browser-function)
+                                    `(eq quack-browse-url-browser-function
+                                         (quote ,func)))])))
+                quack-browser-radio-alist)
+      ["(Other)..."
+       (customize-option 'quack-browse-url-browser-function)
+       :style    radio
+       :selected (not (assq quack-browse-url-browser-function
+                            quack-browser-radio-alist))])
+     ,(quack-bool-menuitem "Tab Characters are Evil" quack-tabs-are-evil-p)
+     ("Local Keywords for Remote Manuals"
+      ,@(quack-radio-menuitems
+         quack-local-keywords-for-remote-manuals-p
+         (("Permit" . t)
+          ("Forbid" . nil)
+          ("Always" . always))))
+     ["PLT Collection Directories..."
+      (customize-option 'quack-pltcollect-dirs)]
+     "---"
+     ["Customize..." quack-customize])
+    "---"
+    ["Run Scheme"              run-scheme]
+    ["Switch to Scheme Buffer" switch-to-scheme]
+    "---"
+    ("View Manual" :filter quack-view-manual-menufilter)
+    ("View SRFI"   :filter quack-view-srfi-menufilter)
+    ["View Keyword Docs..."       quack-view-keyword-docs]
+    ["Dired on PLT Collection..." quack-dired-pltcollect]))
+
+(defun quack-install-global-menu ()
+  (when quack-global-menu-p
+    (quack-when-gnuemacs
+     (unless (assq 'Quack menu-bar-final-items)
+       (setq menu-bar-final-items (cons 'Quack menu-bar-final-items)))
+     (easy-menu-define quack-global-menu global-map ""
+       quack-global-menuspec))
+    (quack-when-xemacs
+     ;; Die! Die! Die!
+     ;;(mapcar (function (lambda (n)
+     ;;(delete-menu-item '("Quack") n)
+     ;;(add-submenu nil quack-global-menuspec "Help" n)))
+     ;;(list 
+     ;;;;current-menubar 
+     ;;default-menubar
+     ;;))
+     (delete-menu-item '("Quack") current-menubar)
+     (add-submenu nil quack-global-menuspec "Help" current-menubar)
+     (set-menubar-dirty-flag))))
+
+;; TODO: We should make sure the user's custom settings have been loaded
+;; before we do this.
+(quack-install-global-menu)
+
+;; And die some more!
+;;(quack-when-xemacs (add-hook 'after-init-hook 'quack-install-global-menu))
+
+(defconst quack-scheme-mode-menuspec
+  `("Scheme"
+    ("Quack Global" ,@(cdr quack-global-menuspec))
+    "---"
+    ["Toggle Lambda Syntax"          quack-toggle-lambda]
+    ["Tidy Buffer Formatting"        quack-tidy-buffer]
+    ["Comment-Out Region"            comment-region]
+    ["Un-Comment-Out Region"         quack-uncomment-region]
+    "---"
+    ["Evaluate Last S-expression"    scheme-send-last-sexp]
+    ["Evaluate Region"               scheme-send-region]
+    ["Evaluate Region & Go"          scheme-send-region-and-go]
+    ["Evaluate Last Definition"      scheme-send-definition]
+    ["Evaluate Last Definition & Go" scheme-send-definition-and-go]
+    ["Compile Definition"            scheme-compile-definition]
+    ["Compile Definition & Go"       scheme-compile-definition-and-go]
+    ["Load Scheme File"              scheme-load-file]
+    ["Compile Scheme File"           scheme-compile-file]
+    "---"
+    ["View Keyword Docs..."          quack-view-keyword-docs]
+    ["Quack Find File"               quack-find-file]))
+
+(defvar quack-scheme-mode-menu)
+(quack-when-gnuemacs
+ (let ((map (make-sparse-keymap)))
+   (setq quack-scheme-mode-menu nil)
+   (easy-menu-define quack-scheme-mode-menu map ""
+     quack-scheme-mode-menuspec)
+   (define-key scheme-mode-map [menu-bar scheme]
+     (cons "Scheme"
+           (or (lookup-key map [menu-bar Scheme])
+               (lookup-key map [menu-bar scheme]))))))
+
+(defun quack-view-manual-menufilter (arg)
+  (quack-menufilter-return "quack-view-manual-menufilter-menu"
+                           (quack-manuals-menu)))
+
+(defun quack-view-srfi-menufilter (arg)
+  (quack-menufilter-return
+   "quack-view-srfi-menufilter-menu"
+   (condition-case nil
+       (quack-srfi-menu t)
+     ;; TODO: Move the generation of this fallback menu down to
+     ;;       quack-srfi-menu.
+     (error '(["Update SRFI Index" quack-update-srfi-index]
+              "---"
+              ("Draft"     :active nil "")
+              ("Final"     :active nil "")
+              ("Withdrawn" :active nil "")
+              ["Other SRFI..."     quack-view-srfi])))))
+
+(defun quack-defaultprogram-menufilter (arg)
+  (quack-menufilter-return
+   "quack-defaultprogram-menufilter-menu"
+   `(,@(quack-optionmenu-items-setdefaultprogram)
+       "---"
+       ["Other Program..." quack-set-other-default-program]
+       "---"
+       ("Forget Program"
+        ,@(mapcar
+           (function
+            (lambda (program)
+              `[,(format "Forget  %s" program)
+                (quack-forget-program ,program)]))
+           quack-programs)))))
+
+(defun quack-optionmenu-items-setdefaultprogram ()
+  (let* ((programs      (quack-sort-string-list-copy quack-programs))
+         (add-default-p (and quack-default-program
+                             (not (member quack-default-program programs)))))
+    (and add-default-p
+         (setq programs (cons quack-default-program programs)))
+    (mapcar
+     (function
+      (lambda (program)
+        (let* ((selected-p (and quack-default-program
+                                (equal program quack-default-program))))
+          `[,(format "%s%s"
+                     program
+                     (if (and add-default-p
+                              (equal program quack-default-program))
+                         " (temporary)"
+                       ""))
+            (quack-option-set 'quack-default-program ,program)
+            :style radio :selected ,selected-p])))
+     programs)))
+
+(mapcar (function (lambda (sym) (put sym 'menu-enable 'mark-active)))
+        '(comment-region
+          indent-region
+          quack-uncomment-region
+          scheme-send-region
+          scheme-send-region-and-go))
+
+;; Option Menu Callbacks:
+
+(defun quack-set-other-default-program ()
+  (interactive)
+  (let* ((minibuffer-allow-text-properties nil)
+         (program (quack-without-side-whitespace
+                   (read-string "Other Default Program: "))))
+    (if (string= program "")
+        (message "Default program unchanged.")
+      (quack-remember-program-maybe program)
+      (quack-option-set 'quack-default-program
+                        program))))
+
+(defun quack-forget-program (program)
+  (setq quack-programs (delete program quack-programs))
+  (quack-option-set 'quack-programs quack-programs t)
+  (message "Forgot program %S." program))
+
+(defun quack-custom-set (sym value)
+  ;; Clean up the value based on the variable symbol.
+  (cond ((eq sym 'quack-programs)
+         (setq value (quack-sort-string-list-copy value))))
+
+  ;; Set default binding.  Set local binding just for the halibut, although if
+  ;; there are local bindings, then other things will likely break.  \(We used
+  ;; to have a check here, but removed it while porting to XEmacs.\)
+  (set         sym value)
+  (set-default sym value)
+
+  ;; TODO: Probably don't do this during Emacs initialization time, to avoid
+  ;;       unnecessary behavior like:
+  ;;
+  ;;           Loading ~/emacs/my-custom.el (source)...
+  ;;           Updating Scheme Mode buffers...done
+  ;;           Updating Scheme Mode buffers...done
+  ;;           Updating Scheme Mode buffers...done
+  ;;           Updating Scheme Mode buffers...done
+  ;;           Updating Scheme Mode buffers...done
+  ;;           Loading ~/emacs/my-custom.el (source)...done
+  
+  ;; Update dependent program state.
+  (cond ((memq sym '(quack-emacsish-keywords-to-fontify
+                     quack-fontify-style
+                     quack-fontify-threesemi-p
+                     quack-pltish-fontify-definition-names-p
+                     quack-pltish-fontify-keywords-p
+                     quack-pltish-keywords-to-fontify
+                     quack-pretty-lambda-p))
+         (quack-update-scheme-mode-buffers))
+
+        ((eq sym 'quack-local-keywords-for-remote-manuals-p)
+         (quack-invalidate-manuals-caches))
+
+        ((eq sym 'quack-pltcollect-dirs)
+         (quack-invalidate-pltcollects-caches))))
+
+(defun quack-option-set (sym value &optional silently)
+  (if quack-options-persist-p
+      (customize-save-variable sym value)
+    (quack-custom-set sym value))
+  (or silently
+      (message "Set %s%s to: %S"
+               sym
+               (if quack-options-persist-p "" " (non-persistently)")
+               value)))
+
+(defun quack-option-toggle (sym &optional silently)
+  (quack-option-set sym (not (symbol-value sym)) t)
+  (or silently
+      (message "Set %s%s %s."
+               sym
+               (if quack-options-persist-p "" " (non-persistently)")
+               (if (symbol-value sym) "ON" "OFF"))))
+
+(defun quack-update-scheme-mode-buffers ()
+  (save-excursion
+    (quack-activity
+     "Updating Scheme Mode buffers"
+     (mapcar (function
+              (lambda (buf)
+                (set-buffer buf)
+                (when (eq major-mode 'scheme-mode)
+                  (quack-activity (format "Updating buffer %S" (buffer-name))
+                                  (scheme-mode)))))
+             (buffer-list)))))
+
+;; Pretty Lambda:
+
+(defconst quack-lambda-char (make-char 'greek-iso8859-7 107))
+
+(defconst quack-pretty-lambda-supported-p
+  (and quack-gnuemacs-p (>= emacs-major-version 21)))
+
+;; Font Lock:
+
+(defconst quack-emacsish1-font-lock-keywords
+  `((,(concat "[[(]"
+              "\\("                     ; #<1
+              "define\\*?"
+                                        ; #=2 #=3
+              (quack-re-alt (quack-re-alt ""
+                                          "-generic"
+                                          "-generic-procedure"
+                                          "-method"
+                                          "-public"
+                                          "/kw"
+                                          "/override"
+                                          "/private"
+                                          "/public")
+                                        ; #=4
+                            (quack-re-alt "-macro"
+                                          "-syntax")
+                            "-class"
+                            "-module"
+                            "-signature"
+                            "-struct")
+              "\\)"                     ; #>1
+              "\\>"
+              "[ \t]*[[(]?"
+                                        ; #=5
+              "\\(\\sw+\\)?")
+     (1 font-lock-keyword-face)
+     (5 (cond ((match-beginning 3) font-lock-function-name-face)
+              ((match-beginning 4) font-lock-variable-name-face)
+              (t                   font-lock-type-face))
+        nil t))
+
+    ;; PLT module definitions.
+    ("[[(]\\(module\\)\\>[ \t]+\\(\\sw+\\)?"
+     (1 font-lock-keyword-face)
+     (2 font-lock-type-face nil t))))
+
+(defconst quack-emacsish2-font-lock-keywords
+  (append quack-emacsish1-font-lock-keywords
+          `(
+            ;; Misc. keywords.
+            (,(concat
+               "[[(]\\("
+               (regexp-opt quack-emacsish-keywords-to-fontify)
+               "\\)\\>")
+             . 1)
+            ;; Class specifiers in SOS, Stklos, Goops.
+            ("\\<<\\sw+>\\>" . font-lock-type-face)
+            ;; Colon keywords.
+            ("\\<:\\sw+\\>" . font-lock-builtin-face))))
+
+(defvar quack-pltish-font-lock-keywords nil)
+
+(defun quack-pltish-num-re (radix digit base16-p)
+  ;; These regexps started as a transliteration of the R5RS BNF to regular
+  ;; expressions, adapted for PLTisms, and with a few optimizations.
+  ;;
+  ;; PLTisms are that 'e' is not permitted as an exponent marker in base-16
+  ;; literals, and that "decimal-point" forms are permitted in any radix.
+  ;;
+  ;; There's obvious opportunity for further optimization, especially if we
+  ;; relax the accepted syntax a little.  These regexps have not been tested
+  ;; much, but, since this is only Emacs syntax fontification, false-positives
+  ;; and false-negatives will be obvious yet benign.
+  (let* ((uint    (concat digit "+#*"))
+         (sign    "[-+]?")
+         (suffix  (quack-re-optional (if base16-p "[sSfFdDlL]" "[eEsSfFdDlL]")
+                                     sign
+                                     "[0-9]+"))
+         (decimal (quack-re-alt
+                   (concat uint suffix)
+                   (concat "\\." digit "+#*" suffix)
+                   (concat digit
+                           "+"
+                           (quack-re-alt (concat "\\." digit "*")
+                                         "#+\\.")
+                           "#*")))
+         (ureal   (quack-re-alt uint
+                                (concat uint "/" uint)
+                                decimal))
+         (real    (concat sign ureal))
+         (complex (quack-re-alt
+                   (concat real
+                           (quack-re-alt (concat "@" real)
+                                         (quack-re-optional
+                                          "[-+]"
+                                          (quack-re-optional ureal)
+                                          "i")
+                                         ""))
+                   (concat "[-+]" (quack-re-optional ureal) "i")))
+         (exact   (quack-re-optional "#[eEiI]"))
+         (prefix  (quack-re-alt (concat radix exact)
+                                (concat exact radix))))
+    (concat "\\<" prefix complex "\\>")))
+
+(defconst quack-pltish-fls-base
+  `(
+    ("\\`\\(MrEd\\|Welcome to MzScheme\\) v[^\n]+" . quack-banner-face)
+    ("\\`Gambit Version 4\\.0[^\n]*" . quack-banner-face)
+    ("\\`Welcome to scsh [0-9][^\n]+\nType ,\\? for help[^\n]+"
+     . quack-banner-face)
+    ("\\`MIT/GNU Scheme running under [^\n]+" . quack-banner-face)
+    ;;("\\`; This is the CHICKEN interpreter - Version [^\n]+\n; (c)[^\n]+"
+    ;; . quack-banner-face)
+    ;;("\\`Scheme Microcode Version[^\n]+\nMIT Scheme[^\n]+\n\\([^\n]+\n\\)+" .
+    ;;quack-banner-face)
+    ;; Unix cookie line.
+    ("\\`#![^\r\n]*" . quack-pltish-comment-face)
+    ;; Colon keywords:
+    ("\\<#:\\sw+\\>" . quack-pltish-colon-keyword-face)
+    ;; Self-evals:
+    ("'\\sw+\\>"                . quack-pltish-selfeval-face)
+    ("'|\\(\\sw\\| \\)+|"       . quack-pltish-selfeval-face)
+    ;; Note: The first alternative in the following rule will misleadingly
+    ;; fontify some invalid syntax, such as "#\(x".
+    ("\\<#\\\\\\([][-`~!@#$%&*()_+=^{}\;:'\"<>,.?/|\\\\]\\|\\sw+\\>\\)"
+     . quack-pltish-selfeval-face)
+    ("[][()]"                   . quack-pltish-paren-face)
+    ("\\<#\\(t\\(?:rue\\)?\\|f\\(?:alse\\)?\\)\\>"       . quack-pltish-selfeval-face)
+    ("\\<+\\(inf.0\\|nan\\)\\>" . quack-pltish-selfeval-face)
+    ("\\<-inf.0\\>"             . quack-pltish-selfeval-face)
+    ,@(mapcar (function (lambda (args)
+                          (cons (apply 'quack-pltish-num-re args)
+                                'quack-pltish-selfeval-face)))
+              '(("#b"        "[01]"        nil)
+                ("#o"        "[0-7]"       nil)
+                ("\\(#d\\)?" "[0-9]"       nil)
+                ("#x"        "[0-9a-fA-F]" t)))))
+
+(defconst quack-pltish-fls-defnames
+  ;; TODO: Optimize these once they're fairly complete and correct.
+
+  ;; TODO: Would be nice to fontify binding names everywhere they are
+  ;;       introduced, such as in `let' and `lambda' forms.  That may require
+  ;;       real parsing to do reasonably well -- the kludges get too bad and
+  ;;       slow, and font-lock gets in the way more than it helps.
+
+  `(
+                                        ;,@quack-pltish-font-lock-keywords
+
+    ;; Lots of definition forms that start with "define".
+    (,(concat "[[(]"
+              "define\\*?"
+              ;; TODO: make this into regexp-opt
+              (quack-re-alt ""
+                            ":"
+                            "-class"
+                            "-class"
+                            "-const-structure"
+                            "-constant"
+                            "-embedded"
+                            "-entry-point"
+                            "-external"
+                            "-for-syntax"
+                            "-foreign-record"
+                            "-foreign-type"
+                            "-foreign-variable"
+                            "-generic"
+                            "-generic-procedure"
+                            "-inline"
+                            "-location"
+                            "-macro"
+                            "-method"
+                            "-opt"
+                            "-parameters"
+                            "-public"
+                            "-reader-ctor"
+                            "-record"
+                            "-record-printer"
+                            "-record-type"
+                            "-signature"
+                            "-structure"
+                            "-syntax"
+                            "-values"
+                            "-values-for-syntax"
+                            "/contract"
+                            "/override"
+                            "/private"
+                            "/public")
+              "\\>"
+              "[ \t]*[[(]?"
+              "\\(\\sw+\\)")
+     (2 (let ((name (quack-match-string-no-properties 2)))
+          (if (= (aref name (1- (length name))) ?%)
+              quack-pltish-class-defn-face
+            quack-pltish-defn-face))
+        nil t))
+
+    ;; Racket "struct" and "define-struct" forms:
+    (,(concat "[[(]"
+              "\\(?:define-\\)?"
+              "struct"
+              "\\>"
+              "[ \t]*[[(]?"
+              "\\(\\sw+\\)")
+     ;; TODO: Use a struct face rather than the class face.
+     (1 quack-pltish-class-defn-face nil t))
+
+    ;; `defmacro' and related SCM forms.
+    (,(concat "[[(]def"
+              (quack-re-alt (concat "macro"
+                                    (quack-re-alt "" "-public"))
+                            "syntax")
+              "\\>[ \t]+\\(\\sw+\\)")
+     3 quack-pltish-defn-face nil t)
+
+    ;; `defmac' from SIOD.
+    ("[[(]defmac[ \t]+[[(][ \t]*\\(\\sw+\\)"
+     1 quack-pltish-defn-face nil t)
+
+    ;; `defvar' and `defun' from SIOD.
+    (,(concat "[[(]def"
+              (quack-re-alt "un"
+                            "var")
+              "[ \t]+\\(\\sw+\\)")
+     2 quack-pltish-defn-face nil t)
+
+    ;; Guile and Chicken `define-module'.
+    ("[[(]define-module\\>[ \t]+[[(][ \t]*\\(\\sw+\\([ \t]+\\sw+\\)*\\)"
+     1 quack-pltish-module-defn-face nil t)
+
+    ;; PLT `define-values', `define-syntaxes', and `define-syntax-set'.
+    (,(concat "[[(]define-"
+              (quack-re-alt "values" "syntax-set" "syntaxes")
+              "\\>[ \t]+[[(][ \t]*\\(\\sw+\\([ \t]+\\sw+\\)*\\)")
+     2 quack-pltish-defn-face nil t)
+
+    ;; PLT `module'.
+    ("[[(]module\\>[ \t]+\\(\\sw+\\)"
+     1 quack-pltish-module-defn-face nil t)
+
+    ;; Named `let'.  (Note: This is disabled because it's too incongruous.)
+    ;;("[[(]let\\>[ \t]+\\(\\sw+\\)"
+    ;; 1 quack-pltish-defn-face nil t)
+    ))
+
+;; TODO: Adding PLT-style (quasi)quoted list fontifying is obviously not doable
+;;       with just regexps.  Probably requires either cloning
+;;       `font-lock-default-fontify-region' just to get it to call our
+;;       replacement syntactic pass fontification function, *or*
+;;       before-advising `font-lock-fontify-keywords-region' to perform our
+;;       syntactic pass when in scheme-mode, and around-advising
+;;       `font-lock-fontify-syntactically-region' to not do anything for
+;;       scheme-mode (or maybe setting `font-lock-keywords-only' to non-nil,
+;;       unless that breaks something else).  Or just ditch font-lock.  See
+;;       `font-lock-fontify-region-function' variable in font-lock specs.
+
+;; (defconst quack-pltish-fls-keywords
+;;   `((,(concat
+;;        "[[(]\\("
+;;        (regexp-opt quack-pltish-keywords-to-fontify)
+;;        "\\)\\>")
+;;      (1 quack-pltish-keyword-face))))
+
+(defun quack-install-fontification ()
+
+  (when (eq quack-fontify-style 'plt)
+    (set (make-local-variable 'font-lock-comment-face)
+         'quack-pltish-comment-face)
+    (set (make-local-variable 'font-lock-string-face)
+         'quack-pltish-selfeval-face))
+
+  (let* ((sk  `(("\\(#\\)\\(|\\)"
+                 (1 ,quack-pound-syntax)
+                 (2 ,quack-bar-syntax))
+                ("\\(|\\)\\(#\\)"
+                 (1 ,quack-bar-syntax)
+                 (2 ,quack-pound-syntax))))
+         (pl  (if (and quack-pretty-lambda-supported-p quack-pretty-lambda-p)
+                  '(("[[(]\\(case-\\|match-\\|opt-\\)?\\(lambda\\)\\>"
+                     2
+                     (progn (compose-region (match-beginning 2)
+                                            (match-end       2)
+                                            quack-lambda-char)
+                            nil)))
+                '()))
+         (threesemi
+          (if quack-fontify-threesemi-p
+              `(
+                (,(concat "^\\(\;\;\;\\)"
+                          ;; TODO: Make this enforce space or newline after the
+                          ;; three semicolons.
+                          "\\("
+                          "[ \t]*"
+                          "\\("
+                          "[^\r\n]*"
+                          "\\)"
+                          "\r?\n?\\)")
+                 (1 quack-threesemi-semi-face prepend)
+                 (2 quack-threesemi-text-face prepend)
+                 ;;(4 quack-threesemi-h1-face   prepend)
+                 ;;(5 quack-threesemi-h2-face   prepend)
+                 )
+
+                ;; Funcelit:
+                ("^\;\;\; @\\(Package\\|section\\|unnumberedsec\\)[ \t]+\\([^\r\n]*\\)"
+                 (2 quack-threesemi-h1-face prepend))
+                ("^\;\;\; @subsection[ \t]+\\([^\r\n]*\\)"
+                 (1 quack-threesemi-h2-face prepend))
+
+                ("^\;\;\; @section\\(?:\\[[^]]*\\]\\)?{\\([^\r\n]*\\)}"
+                 (1 quack-threesemi-h1-face prepend))
+                ("^\;\;\; @subsection\\(?:\\[[^]]*\\]\\)?{\\([^\r\n]*\\)}"
+                 (1 quack-threesemi-h2-face prepend))
+                
+                
+                )
+            '()))
+         (fld `(,(cond
+                  ((eq quack-fontify-style 'plt)
+                   (set (make-local-variable
+                         'quack-pltish-font-lock-keywords)
+                        `(,@quack-pltish-fls-base
+                          ,@(if quack-pltish-fontify-definition-names-p
+                                quack-pltish-fls-defnames
+                              '())
+                          ,@pl
+                          ,@(if quack-pltish-fontify-keywords-p
+                                ;; quack-pltish-fls-keywords
+                                `((,(concat
+                                     "[[(]\\("
+                                     (regexp-opt
+                                      quack-pltish-keywords-to-fontify)
+                                     "\\)\\>")
+                                   (1 quack-pltish-keyword-face)))
+                              '())
+                          ,@threesemi
+                          ))
+                   'quack-pltish-font-lock-keywords)
+                  ((eq quack-fontify-style 'emacs)
+                   ;; TODO: Do pretty-lambda here too.  But first get rid of
+                   ;;       this font-lock style "degrees of general gaudiness"
+                   ;;       and switch to separate options for each property of
+                   ;;       fontification.
+                   '(quack-emacsish1-font-lock-keywords
+                     quack-emacsish1-font-lock-keywords
+                     quack-emacsish2-font-lock-keywords))
+                  (t (quack-internal-error)))
+                nil
+                t
+                ((?! . "w") (?$ . "w") (?% . "w") (?& . "w") (?* . "w")
+                 (?+ . "w") (?- . "w") (?. . "w") (?/ . "w") (?: . "w")
+                 (?< . "w") (?= . "w") (?> . "w") (?? . "w") (?@ . "w")
+                 (?^ . "w") (?_ . "w") (?~ . "w")
+                 ,@(if (eq quack-fontify-style 'plt)
+                       '((?# . "w"))
+                     '()))
+                ;; TODO: Using `beginning-of-defun' here could be very slow,
+                ;;       say, when you have a large buffer that is wrapped in a
+                ;;       `module' form.  Look into whether this is a problem.
+                beginning-of-defun
+                ,@(if t                 ; quack-gnuemacs-p
+                      `((font-lock-mark-block-function . mark-defun)
+                        (font-lock-syntactic-keywords  . ,sk))
+                    '()))))
+
+    ;; TODO: Figure out why `font-lock-syntactic-keywords' just doesn't work in
+    ;;       XEmacs 21, even though the syntax text properties seem to get set.
+    ;;       We have already beaten it like an egg-sucking dog.
+
+    ;;(if quack-xemacs-p
+    ;;(put 'scheme-mode 'font-lock-defaults fld)
+    (set (make-local-variable 'font-lock-defaults) fld)
+    ;;)
+
+    ;;(when quack-xemacs-p
+    ;;  (set (make-local-variable 'font-lock-syntactic-keywords)
+    ;;       syntactic-keywords))
+    ))
+
+;; Scheme Mode Startup Hook:
+
+(defun quack-locally-steal-key-bindings (old-func new-func)
+  (mapcar (function (lambda (key)
+                      (unless (and (vectorp key)
+                                   (eq (aref key 0) 'menu-bar))
+                        (local-set-key key new-func))))
+          (where-is-internal old-func)))
+
+(defun quack-shared-mode-hookfunc-stuff ()
+
+  ;; Install the Quack keymap and menu items.
+  (local-set-key quack-scheme-mode-keymap-prefix quack-scheme-mode-keymap)
+  (quack-when-xemacs
+   (when (featurep 'menubar)
+     ;;(set-buffer-menubar current-menubar)
+     ;; TODO: For XEmacs, we could have two versions of this menu -- the popup
+     ;;       one would have the Global submenu, but the menubar one would have
+     ;;       the Global submenu only if quack-global-menu-p were nil.
+     (add-submenu nil quack-scheme-mode-menuspec)
+     (set-menubar-dirty-flag)
+     (setq mode-popup-menu quack-scheme-mode-menuspec)))
+
+  ;; Bind the paren-matching keys.
+  (local-set-key ")" 'quack-insert-closing-paren)
+  (local-set-key "]" 'quack-insert-closing-bracket)
+
+  (local-set-key "(" 'quack-insert-opening-paren)
+  (local-set-key "[" 'quack-insert-opening-bracket)
+
+  ;; Steal any find-file bindings.
+  (when quack-remap-find-file-bindings-p
+    (quack-locally-steal-key-bindings 'find-file     'quack-find-file)
+    (quack-locally-steal-key-bindings 'ido-find-file 'quack-find-file))
+
+  ;; Fight against tabs.
+  (when quack-tabs-are-evil-p
+    (setq indent-tabs-mode nil))
+
+  ;; Remove character compositions, to get rid of any pretty-lambda.  (Note:
+  ;; This is bad, if it turns out compositions are used for other purposes in
+  ;; buffers that are edited with Scheme Mode.)
+  (when quack-pretty-lambda-supported-p
+    (eval '(decompose-region (point-min) (point-max))))
+
+  ;; Install fontification
+  (when quack-fontify-style
+    (when (and (boundp 'font-lock-keywords)
+               (symbol-value 'font-lock-keywords)
+               (not (featurep 'noweb-mode)))
+      ;; This warning is not given if the `noweb-mode' package is installed.
+      (quack-warning "`font-lock-keywords' already set when hook ran."))
+    (quack-install-fontification))
+
+  ;; Die! Die! Die!
+  (quack-when-xemacs
+   (quack-install-global-menu)))
+
+(defun quack-inferior-scheme-mode-hookfunc ()
+  (quack-shared-mode-hookfunc-stuff))
+
+(defun quack-scheme-mode-hookfunc ()
+  (quack-shared-mode-hookfunc-stuff)
+
+  ;; Bind Return/Enter key.
+  (local-set-key "\r" 'quack-newline)
+
+  ;; Install toolbar.
+  ;;(unless quack-xemacs-p
+  ;;(when (display-graphic-p)
+  ;;(quack-install-tool-bar)))
+  )
+
+(add-hook 'scheme-mode-hook          'quack-scheme-mode-hookfunc)
+(add-hook 'inferior-scheme-mode-hook 'quack-inferior-scheme-mode-hookfunc)
+
+;; Compilation Mode:
+
+;; TODO: Add compilation-directory-matcher support for "setup-plt:  in".
+
+(defvar quack-saved-compilation-error-regexp-alist nil)
+
+(defconst quack-compilation-error-regexp-alist-additions
+  (let ((no-line (if quack-xemacs-p
+                     (let ((m (make-marker))) (set-marker m 0) m)
+                   'quack-compile-no-line-number)))
+  `(
+
+    ;; Racket 5.1.1 "raco" compile error (which can have multiple spaces):
+    ("^raco\\(?:cgc\\)?: +\\([^: ][^:]*\\):\\([0-9]+\\):\\([0-9]+\\):"
+     1 2 3)
+
+    ;; Racket 5.1.1 entries without line number info in "=== context ===":
+    ("^\\(/[^:]+\\): \\[running body\\]$" 1 nil nil 0)
+
+    ;; PLT MzScheme 4.1.4 "=== context ===" traceback when there is only file,
+    ;; line, and column info, but potentially no following ":" and additional
+    ;; info like procedure name.
+    ("^\\([^:\n\" ]+\\):\\([0-9]+\\):\\([0-9]+\\)" 1 2 3)
+
+    ;; PLT MzScheme 205 "setup-plt"
+    ;;   load-handler: expected a `module' declaration for `bar-unit' in
+    ;;   "/u/collects/bar/bar-unit.ss", but found something else
+    (,(concat "load-handler: expected a `module' declaration for `[^']+' in "
+              "\"\\([^:\n\"]+\\)\", but found something else")
+     1 ,no-line)
+
+    ;; PLT MzScheme 205 "setup-plt".
+    ;;   setup-plt: Error during Compiling .zos for Foo Bar (/u/collects/fb)
+    ("setup-plt: Error during Compiling .zos for [^\n]+ \(\\([^\n\)]+\\)\)"
+     1 ,no-line)
+
+    ;; PLT MzScheme 4.0.1 "setup-plt".
+    ("setup-plt: +\\(?:WARNING: +\\)\\([^:\n]+\\)::"
+     1 ,no-line)
+
+    ;; PLT MzScheme 4.0.1 "setup-plt".
+    ("setup-plt: +\\(?:WARNING: +\\)\\([^:\n ][^:\n]*\\):\\([0-9]+\\):\\([0-9]+\\)"
+     1 2 3)
+
+    ;; PLT MzScheme 4.0.1 "setup-plt":
+    ("load-handler: expected a `module' declaration for `[^'\n]+' in #\n]+\\)>[^\n]+"
+     1 ,no-line)
+
+    ;; PLT Scheme 4.1.2 "default-load-handler" error without useful filename:
+    ("default-load-handler: cannot open input-file: "
+     nil ,no-line)
+
+    )))
+
+(defun quack-compile-no-line-number (filename column)
+  (list (point-marker) filename 1 (and column (string-to-number column))))
+
+(defun quack-install-compilation-mode-stuff ()
+  (unless quack-saved-compilation-error-regexp-alist
+    (setq quack-saved-compilation-error-regexp-alist 
+          compilation-error-regexp-alist))
+  (setq compilation-error-regexp-alist
+        (append quack-compilation-error-regexp-alist-additions
+                quack-saved-compilation-error-regexp-alist)))
+
+(quack-install-compilation-mode-stuff)
+
+;; Interpreter-mode-alist:
+
+(defvar quack-saved-interpreter-mode-alist nil)
+
+(defvar quack-interpreter-mode-alist-additions
+  (mapcar (function (lambda (x)
+                      (cons x 'scheme-mode)))
+          '("bigloo"
+            "csi"
+            "gosh"
+            "gsi"
+            "guile"
+            "kawa"
+            "mit-scheme"
+            "mred"
+            "mred3m"
+            "mredcgc"
+            "mzscheme"
+            "mzscheme3m"
+            "mzschemecgc"
+            "r5rs"
+            "r6rs"
+            "rs"
+            "rs"
+            "scheme"
+            "scheme48"
+            "scsh"
+            "sisc"
+            "stklos"
+            "sxi")))
+
+(defun quack-install-interpreter-mode-alist ()
+  (unless quack-saved-interpreter-mode-alist
+    (setq quack-saved-interpreter-mode-alist
+          interpreter-mode-alist))
+  (setq interpreter-mode-alist
+        (append quack-interpreter-mode-alist-additions
+                quack-saved-interpreter-mode-alist)))
+
+(quack-install-interpreter-mode-alist)
+
+;; PLT Package Mode:
+
+;; TODO: Do some simple checking and summarize what directories and files are
+;;       getting modified by this package.
+
+;; TODO: Maybe don't worry about preserving the decompressed text verbatim in
+;;       the buffer -- set markers and generate headings, and be able to
+;;       construct valid package.
+
+;; TODO: Command to install package from original file using "setup-plt".
+
+;; TODO: Fontify Scheme code file contents.
+
+(defvar quack-pltfile-mode-hook nil)
+
+(defvar quack-hiding-ovlcat)
+(put 'quack-hiding-ovlcat 'face       'default)
+(put 'quack-hiding-ovlcat 'intangible t)
+(put 'quack-hiding-ovlcat 'invisible  t)
+
+(defvar quack-pltfile-mode-map (make-sparse-keymap))
+(define-key quack-pltfile-mode-map "q" 'quack-pltfile-quit)
+(define-key quack-pltfile-mode-map "r" 'quack-pltfile-raw)
+(define-key quack-pltfile-mode-map " " 'scroll-up)
+
+;; TODO: Make a menu map for pltfile-mode.
+
+(defun quack-pltfile-mode ()
+  (interactive)
+  "Major mode for viewing PLT Scheme `.plt' package files.
+
+\\{quack-pltfile-mode-map}
+
+Provided by Quack: http://www.neilvandyke.org/quack/"
+  (kill-all-local-variables)
+  (put 'quack-pltfile-mode 'mode-class 'special)
+  (setq major-mode 'quack-pltfile-mode)
+  (setq mode-name "PLT Package")
+  (use-local-map quack-pltfile-mode-map)
+  ;; Note: Currently, the `font-lock' feature is always defined, since we
+  ;; require it.
+  (when (featurep 'font-lock)
+    (setq font-lock-defaults nil))
+  (buffer-disable-undo)
+  (let ((saved-bmp (buffer-modified-p)))
+    (quack-activity "Decoding PLT package" (quack-pltfile-decode-buffer))
+    (setq buffer-read-only t)
+    (set-buffer-modified-p saved-bmp))
+  (quack-when-xemacs
+   (make-variable-buffer-local 'write-contents-hooks))
+  (add-hook 'write-contents-hooks 'quack-prevent-pltfile-write)
+  (run-hooks 'quack-pltfile-mode-hook)
+  (message "Decoded PLT package.  %s"
+           (substitute-command-keys
+            (concat "`\\[quack-pltfile-quit]' to quit"
+                    ", `\\[quack-pltfile-raw]' for raw format."))))
+
+(defun quack-prevent-pltfile-write ()
+  (unless (yes-or-no-p
+           "Write a decoded PLT package buffer?!  Are you *sure*?!")
+    (error "Aborted write of decoded PLT package buffer.")))
+
+(defun quack-pltfile-raw ()
+  (interactive)
+  (let ((auto-mode-alist '()))
+    (setq buffer-read-only nil)
+    (widen)
+    (delete-region (point-min) (point-max))
+    (fundamental-mode)
+    (revert-buffer t t)))
+
+(defun quack-pltfile-quit ()
+  (interactive)
+  (kill-buffer (current-buffer)))
+
+(defun quack-skip-whitespace-to-nonblank-line-beginning ()
+  (save-match-data
+    (while (looking-at "[ \t\r\f]*\n")
+      (goto-char (match-end 0)))))
+
+(defun quack-pltfile-decode-buffer ()
+
+  ;; MIME Base-64 decode.  (Note: an error is signaled if this fails.)
+  (base64-decode-region (point-min) (point-max))
+
+  ;; Gzip decompress.
+  (let ((coding-system-for-write (if quack-xemacs-p 'binary 'raw-text-unix))
+        (coding-system-for-read  (if quack-xemacs-p 'binary 'raw-text-unix))
+        (inhibit-eol-conversion  t)
+        status)
+    (unless (= (setq status (call-process-region (point-min) (point-max)
+                                                 "gzip" t t nil "-d")) 0)
+      (error "Could not decompress PLT package: gzip process status %s"
+             status)))
+
+  ;; Move past the "PLT" cookie, and the two sexp forms.
+  (goto-char (point-min))
+  (unless (looking-at "PLT")
+    (error "This does not appear to be a PLT package file."))
+  (goto-char (match-end 0))
+  (forward-list 2)
+  (quack-skip-whitespace-to-nonblank-line-beginning)
+  (quack-make-face-ovlext (point-min) (point) 'quack-pltfile-prologue-face)
+
+  ;; Process the buffer contents.
+  (let ((standard-input (current-buffer)))
+
+    (while (not (eobp))
+      (let ((step-beg (point)))
+        ;; TODO: This read will fail if we just had whitespace at the end of
+        ;;       the file, which it shouldn't, but maybe we should check, just
+        ;;       in case.
+        (let ((sym (read)))
+          (unless (symbolp sym)
+            (error "Expected a symbol, but saw: %S" sym))
+          (cond
+
+           ((eq sym 'dir)
+            (forward-list)
+            (quack-skip-whitespace-to-nonblank-line-beginning)
+            (quack-make-face-ovlext step-beg
+                                    (point)
+                                    'quack-pltfile-dir-face))
+
+           ((memq sym '(file file-replace))
+            (forward-list)
+            (let ((size (read)))
+              (unless (and (integerp size) (>= size 0))
+                (error "Expected a file size, but saw: %S" size))
+              (unless (looking-at "[ \t\r\n\f]*\\*")
+                (error "Expected a `*' after file size."))
+              (goto-char (match-end 0))
+
+              ;; Fontify the file header.
+              (quack-make-face-ovlext step-beg
+                                      (1- (point))
+                                      'quack-pltfile-file-face)
+
+              ;; Hide the file contents asterisk.
+              (quack-make-hiding-ovlext (1- (point)) (point))
+
+              ;; Set the coding region for the content.
+              (let* ((content-beg (point))
+                     (content-end (+ content-beg size))
+                     (cs          (detect-coding-region content-beg
+                                                        content-end)))
+                (goto-char content-end)
+                (when (listp cs)
+                  (setq cs (car cs)))
+                (unless (eq cs 'undecided)
+                  (cond ((eq cs 'undecided-dos)  (setq cs 'raw-text-dos))
+                        ((eq cs 'undecided-mac)  (setq cs 'raw-text-mac))
+                        ((eq cs 'undecided-unix) (setq cs 'raw-text-unix)))
+                  (decode-coding-region content-beg content-end cs))
+                ;; TODO: XEmacs 21 `decode-coding-region' seems to lose the
+                ;;       point position.  This is disconcerting, since the
+                ;;       point semantics under coding system changes do not
+                ;;       currently seem to be well-specified, so resetting the
+                ;;       point here *might* not always be the right thing to
+                ;;       do.  Verify.
+                (quack-when-xemacs
+                 (goto-char content-end)))))
+
+           (t (error "Expected `dir', `file', or `file-replace', but saw: %S"
+                     sym)))))))
+
+  ;; Return point to top of buffer.
+  (goto-char (point-min)))
+
+;; The rest of this file except for the `provide' form is TODO comments.
+
+;; TODO: Add tool bar support later.
+;;
+;; (defvar quack-toolbarimage-width  24)
+;; (defvar quack-toolbarimage-height 24)
+;;
+;; (defun quack-create-image (&rest args)
+;;   (if (and quack-gnuemacs-p (>= emacs-major-version 21))
+;;       (apply 'create-image args)
+;;     nil))
+;;
+;; (defun quack-make-toolbarimage (&rest lines)
+;;   ;; TODO: We really should make an efficient function to print N spaces
+;;   ;;       or to return a string of N spaces.  Or at least keep 1-2
+;;   ;;       strings for the left and right padding here, which will
+;;   ;;       usually be the same for the duration of this function.
+;;   (quack-create-image
+;;    (let* ((lines-count (length lines))
+;;           (blank-line  (make-string quack-toolbarimage-width 32)))
+;;      (and (> lines-count quack-toolbarimage-height) (quack-internal-error))
+;;      (with-output-to-string
+;;        (princ "/* XPM */\nstatic char *magick[] = {\n")
+;;        ;;(princ "/* columns rows colors chars-per-pixel */\n")
+;;        (princ (format "\"%d %d 5 1\",\n"
+;;                       quack-toolbarimage-width quack-toolbarimage-height))
+;;        (princ "\". c #f0f0f0\",\n")
+;;        (princ "\"@ c #0f0f0f\",\n")
+;;        (princ "\"g c #00b000\",\n")
+;;        (princ "\"r c #d00000\",\n")
+;;        (princ "\"  c None\",\n")
+;;        ;;(princ "/* pixels */\n")
+;;        (let ((line-num 0))
+;;          (mapcar (function
+;;                   (lambda (line)
+;;                     (princ "\"")
+;;                     (if line
+;;                         (let* ((c (length line))
+;;                                (l (/ (- quack-toolbarimage-width c) 2)))
+;;                           (and (> c quack-toolbarimage-width)
+;;                                (quack-internal-error))
+;;                           (princ (make-string l 32))
+;;                           (princ line)
+;;                           (princ (make-string (- quack-toolbarimage-width
+;;                                                  c l)
+;;                                               32)))
+;;                       (princ blank-line))
+;;                     (if (< (setq line-num (1+ line-num))
+;;                            quack-toolbarimage-height)
+;;                         (princ "\",\n")
+;;                       (princ "\"\n"))))
+;;                  (let ((rows-before (/ (- quack-toolbarimage-width
+;;                                           lines-count)
+;;                                        2)))
+;;                    `(,@(make-list rows-before nil)
+;;                        ,@lines
+;;                        ,@(make-list (- quack-toolbarimage-height
+;;                                        lines-count rows-before)
+;;                                     nil)))))
+;;        (princ "};\n")))
+;;    'xpm t))
+;;
+;; (defvar quack-tbi-evalbuf
+;;   (quack-make-toolbarimage
+;;    "@@@@@@@@@@          "
+;;    "@........@@         "
+;;    "@........@.@   ggg  "
+;;    "@........@..@  ggg  "
+;;    "@........@@@@@ ggg  "
+;;    "@............@ ggg  "
+;;    "@..@@........@ ggg  "
+;;    "@...@@.......@ ggg  "
+;;    "@....@@......@ ggg  "
+;;    "@.....@@.....@ ggg  "
+;;    "@....@@@@....@ ggg  "
+;;    "@...@@..@@...@ ggg  "
+;;    "@..@@....@@..@ ggg  "
+;;    "@............@ ggg  "
+;;    "@@@@@@@@@@@@@@ ggg  "
+;;    "               ggg  "
+;;    "             ggggggg"
+;;    "              ggggg "
+;;    "               ggg  "
+;;    "                g   "))
+;;
+;; (defvar quack-tbi-adoc
+;;   (quack-make-toolbarimage
+;;    "@@@@@@@@@@    "
+;;    "@........@@   "
+;;    "@........@.@  "
+;;    "@........@..@ "
+;;    "@........@@@@@"
+;;    "@...@@@......@"
+;;    "@..@@@@@@....@"
+;;    "@..@....@@...@"
+;;    "@...@@@.@@...@"
+;;    "@..@@@@@@@...@"
+;;    "@..@@...@@...@"
+;;    "@..@@..@@@...@"
+;;    "@...@@@@.@@..@"
+;;    "@............@"
+;;    "@@@@@@@@@@@@@@"))
+;;
+;; (defvar quack-tbi-manual
+;;   (quack-make-toolbarimage
+;;    "@@@@@@@@@@    "
+;;    "@........@@   "
+;;    "@........@.@  "
+;;    "@........@..@ "
+;;    "@........@@@@@"
+;;    "@............@"
+;;    "@..@@.@.@@...@"
+;;    "@..@@@@@@@@..@"
+;;    "@..@@.@@.@@..@"
+;;    "@..@@.@@.@@..@"
+;;    "@..@@.@@.@@..@"
+;;    "@..@@.@@.@@..@"
+;;    "@..@@.@@.@@..@"
+;;    "@............@"
+;;    "@@@@@@@@@@@@@@"))
+;;
+;; (defvar quack-tbi-manuallookup
+;;   (quack-make-toolbarimage
+;;    "@@@@@@@@@@          "
+;;    "@........@@         "
+;;    "@........@.@        "
+;;    "@........@..@       "
+;;    "@........@@@@@      "
+;;    "@............@      "
+;;    "@..@@.@@@@@@@@@@    "
+;;    "@...@@@........@@   "
+;;    "@....@@........@.@  "
+;;    "@.....@........@..@ "
+;;    "@....@@........@@@@@"
+;;    "@...@@@............@"
+;;    "@..@@.@..@@.@.@@...@"
+;;    "@.....@..@@@@@@@@..@"
+;;    "@@@@@@@..@@.@@.@@..@"
+;;    "      @..@@.@@.@@..@"
+;;    "      @..@@.@@.@@..@"
+;;    "      @..@@.@@.@@..@"
+;;    "      @..@@.@@.@@..@"
+;;    "      @............@"
+;;    "      @@@@@@@@@@@@@@"))
+;;
+;; (defvar quack-tbi-stop
+;;   (quack-make-toolbarimage
+;;    "    @@@@@    "
+;;    "  @@rrrrr@@  "
+;;    " @rrrrrrrrr@ "
+;;    " @rrrrrrrrr@ "
+;;    "@rr@@rrr@@rr@"
+;;    "@rrr@@r@@rrr@"
+;;    "@rrrr@@@rrrr@"
+;;    "@rrr@@r@@rrr@"
+;;    "@rr@@rrr@@rr@"
+;;    " @rrrrrrrrr@ "
+;;    " @rrrrrrrrr@ "
+;;    "  @@rrrrr@@  "
+;;    "    @@@@@    "))
+;;
+;; (defun quack-install-tool-bar ()
+;;   (require 'tool-bar)
+;;   (let ((map (make-sparse-keymap)))
+;;
+;;     (quack-define-key-after map [quack-load-file]
+;;                             `(menu-item "quack-evalbuffer" scheme-load-file
+;;                                         :image ,quack-tbi-evalbuf
+;;                                         :help  "Load File"))
+;;
+;;     (quack-define-key-after map [quack-alpha]
+;;                             `(menu-item "quack-alpha" quack-alpha
+;;                                         :image ,quack-tbi-adoc
+;;                                         :help  "alpha"))
+;;
+;;     (quack-define-key-after map [quack-manual]
+;;                             `(menu-item "quack-manual" quack-manual
+;;                                         :image ,quack-tbi-manual
+;;                                         :help  "View Manual"))
+;;
+;;     (quack-define-key-after map [quack-view-keyword-docs]
+;;                             `(menu-item "quack-view-keyword-docs"
+;;                                         quack-view-keyword-docs
+;;                                         :image ,quack-tbi-manuallookup
+;;                                         :help  "View Keyword Docs"))
+;;
+;;     (quack-define-key-after map [quack-stop]
+;;                             `(menu-item "quack-stop" quack-stop
+;;                                         :image ,quack-tbi-stop
+;;                                         :help  "Stop"))
+;;
+;;     (set (make-local-variable 'tool-bar-map) map)))
+
+;; TODO: Extend `scheme-imenu-generic-expression' for PLT-specific definition
+;;       forms and for definitions within modules.
+
+;; TODO: Clickable URLs
+;;
+;; (defvar quack-url-keymap)
+;; 
+;; (setq quack-url-keymap (make-sparse-keymap))
+;; (define-key quack-url-keymap "\r" 'quack-browse-overlaid-url)
+;; (define-key quack-url-keymap "q" 'quack-browse-overlaid-url)
+;; 
+;; (defun quack-make-url-overlay (beg end &optional url)
+;;   (let ((ovl (make-overlay beg end nil t)))
+;;     (overlay-put ovl 'face      'underline)
+;;     (overlay-put ovl 'local-map 'quack-url-keymap)
+;;     (overlay-put ovl 'help-echo "Press RET to browse this URL.")
+;;     (overlay-put ovl 'quack-url
+;;                      (or url (buffer-substring-no-properties beg end)))
+;;     ovl))
+;; 
+;; (defun quack-insert-url (url)
+;;   (let* ((beg (point)))
+;;     (insert url)
+;;     (quack-make-url-overlay beg (point))))
+;; 
+;; (defun quack-overlaid-url-at-point (&optional pt)
+;;   (let ((overlays (overlays-at (or pt (point))))
+;;         (url      nil))
+;;     (while overlays
+;;       (setq overlays (if (setq url (overlay-get (car overlays) 'quack-url))
+;;                          (cdr overlays)
+;;                        '())))
+;;     url))
+;; 
+;; (defun quack-browse-overlaid-url (pt)
+;;   ;; Dehydration.
+;;   (interactive "d")
+;;   (quack-browse-url (quack-overlaid-url-at-point pt)))
+
+;; TODO: Possible Future Inferior Process I/O Stuff.  Make encoding with
+;;       inferior process disambiguate REPL values, port output, error info,
+;;       etc.  Start of code commented out below.  This may require rewriting
+;;       chunks of `cmuscheme' and `comint'.
+;;
+;;       Try to use ELI protocol first.  http://www.cliki.net/ELI
+;;
+;; (defface quack-output-face
+;;   '((((class color)) (:foreground "purple4" :background "lavender"))
+;;     (t               (:inverse-video t)))
+;;   "Face used for..."
+;;   :group 'quack)
+;;
+;; (defface quack-value-face
+;;   '((((class color)) (:foreground "blue4" :background "light sky blue"))
+;;     (t               (:inverse-video t)))
+;;   "Face used for..."
+;;   :group 'quack)
+;;
+;; Escape Codes:
+;;     REPL State:
+;;         R  repl read begin
+;;         r  repl read end
+;;         E  repl eval begin
+;;         e  repl eval end
+;;         P  repl print begin
+;;         p  repl print end
+;;     Stream Change:
+;;         O  output stream
+;;         E  error stream
+;;     Error Info?
+;;
+;; (defconst quack-mzscheme-init-string
+;;   (let ((print-length nil)
+;;         (print-level  nil))
+;;     (prin1-to-string
+;;      '(let ((o (current-output-port))
+;;             (i (current-input-port))
+;;             (e (current-eval)))
+;;         ;; TODO: Define custom escaping output and error ports here.
+;;         (current-prompt-read
+;;          (lambda ()
+;;            (display "\eR" o)
+;;            (begin0 (read-syntax "quack-repl" i)
+;;                    (display "\er" o))))
+;;         (current-eval
+;;          (lambda (n)
+;;            (display "\eE" o)
+;;            (begin0 (e n)
+;;                    (display "\ee" o))))
+;;         (current-print
+;;          (lambda (n)
+;;            (display "\eP" o)
+;;            (begin0 (print n o)
+;;                    (display "\ep" o))))))))
+;;
+;; In `quack' function, after call to `run-scheme':
+;;
+;; (add-hook 'comint-preoutput-filter-functions
+;;           'quack-comint-preoutput-filter-func)
+;; (comint-send-string (scheme-proc) quack-mzscheme-init-string)
+;; (comint-send-string (scheme-proc) "\n")
+
+;; TODO: If we do that, then add pretty-printing of REPL results.
+
+;; TODO: Maybe provide utilities for converting to/from PLT-style
+;;       square-bracket paren conventions.
+
+;; TODO: Populate abbrevs table from keywords extracted from manuals, and from
+;;       definitions in current buffer.  Or maybe query running MzScheme
+;;       process for bound symbols.
+
+;; TODO: Maybe use `compile-zos' to do error-checking for PLT (look up person
+;;       to credit with idea of using that to get more warnings).  Need to know
+;;       more about a particular Scheme implementation than just the command
+;;       line to start its REPL, though.
+
+;; TODO: Perhaps put some initialization code that depends on user's custom
+;;       settings into after-init-hook.  See if this works in XEmacs.
+
+;; TODO: Set `interpreter-mode-alist' based on interpreter list.
+
+;; TODO: "I think it would be good if the quack menu showed up only when emacs
+;;        was in Scheme mode."
+
+;; TODO: Support this:
+;;
+;;       * Added 'addon-dir for `find-system-path':
+;;       Unix: "~/.plt-scheme"
+;;       Windows: "PLT Scheme" in the user's Application Data folder.
+;;       Mac OS X: "~/Library/PLT Scheme"
+;;       Mac OS Classic: "PLT Scheme" in the preferences folder.
+;;
+;;       The version string for "~/.plt-scheme//collects/" might be:
+;;       mzscheme -mqe '(begin (display (version)) (exit))'
+;;       Double-check PLT source first.
+
+;; TODO: Add autoindenting to inferior Scheme buffer when pressing RET on an
+;;       incomplete sexp -- iff we can do this reliably enough.
+
+;; TODO: When tidying and point is within a series of multiple blank lines that
+;;       are reduced to a single blank line, leave point at the beginning of
+;;       the single blank line.
+
+;; TODO: Riastradh says: Do you suppose you could add a feature to Quack that
+;;       indents lists beginning with symbols of the form WITH-...  &
+;;       CALL-WITH-... as if their SCHEME-INDENT-FUNCTION property were DEFUN?
+
+;; TODO: Matt Dickerson asks " Also, the command history appears to be based on
+;;       newlines -- I work with blocks of code in the REPL and would like C-p
+;;       to give me the last block, not the last line of the previous block."
+
+;; TODO: Maybe get appropriate PLT collection path from the default for
+;;       whatever "mzscheme" executable is picked up.
+;;
+;; mzscheme -emq '(begin (write (current-library-collection-paths)) (exit 0))'
+;; ("/home/neil/collects" "/home/neil/.plt-scheme/208/collects"
+;;  "/usr/lib/plt/collects")
+
+;; TODO: Bind M-[ to quack-insert-parentheses
+
+;; TODO: Peter Barabas reports that `quack-global-menu-p' set to nil doesn't
+;; disable the menu.
+
+;; TODO: Way to get default collects directories.  From Matthew Flatt,
+;; 2006-04-22:
+;; 
+;; env PLTCOLLECTS="" mzscheme -mvqe '(printf "~s\n" (map path->string 
+;; (current-library-collection-paths)))'
+
+;; TODO: Have key binding to insert "lambda" (for use with pretty-lambda).
+;; Suggested by Olwe Bottorff on 2006-04-20.
+
+;; TODO: Jerry van Dijk writes: "I would like to try out quack, but I do not
+;; like its menu constantly on the main menu bar (as I use emacs for a lot of
+;; things). Unfortunately sofar quack has bravely defied all my attempts to
+;; remove it. From desecting the customize option to adding (define-key
+;; global-map [menu-bar quack] nil)"
+
+;; TODO: We could do this:
+;;
+;; mzscheme -m -e "(begin (display #\') (write (map path->string (current-library-collection-paths))) (newline) (exit))"
+;; '("/home/neil/collects"
+;;   "/home/neil/.plt-scheme/360/collects"
+;;   "/usr/lib/plt/collects")
+
+;; emacs22  -batch -no-site-file -f batch-byte-compile quack.el ; rm quack.elc
+;; emacs21  -batch -no-site-file -f batch-byte-compile quack.el ; rm quack.elc
+;; emacs20  -batch -no-site-file -f batch-byte-compile quack.el ; rm quack.elc
+;; xemacs21 -batch -no-site-file -f batch-byte-compile quack.el ; rm quack.elc
+
+;; End:
+
+(provide 'quack)
+
+;; quack.el ends here
diff --git a/elisp/emacs-goodies-el/rfcview.el b/elisp/emacs-goodies-el/rfcview.el
new file mode 100644
index 0000000..eefe201
--- /dev/null
+++ b/elisp/emacs-goodies-el/rfcview.el
@@ -0,0 +1,860 @@
+;;; rfcview.el -- view IETF RFCs with readability-improved formatting
+
+;; Copyright (C) 2001-2002 Neil W. Van Dyke
+;; Copyright (C) 2006, 2008, 2009 Free Software Foundation, Inc.
+;;    (mods by Dave Love )
+
+;; Author:   Neil W. Van Dyke 
+;; Author: Dave Love 
+;; Version:  0.13
+;; X-URL:    http://www.loveshack.ukfsn.org/emacs/rfcview.el
+
+;; This file is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see .
+
+;; [Van Dyke's original is GPL 2 or later.]
+
+;;; COMMENTARY:
+
+;; Introduction:
+;;
+;;   For historical reasons, IETF Internet RFCs are required to be in a plain
+;;   ASCII text format that's best-suited for sending directly to a 6-lpi
+;;   US-letter-size printer.  This makes them suboptimal for viewing on-screen,
+;;   as you will be doing for countless hours if you're ever doing network
+;;   programming to one of them.  Fortunately, the ASCII format is usually
+;;   close to what you, the Emacs zealot, *truly* want -- which is a format
+;;   suited to more pleasurably viewing the RFC in Emacs.
+;;
+;;   The `rfcview' package uses Emacs overlays to add some fontification and
+;;   hide the page headers and footers (which it replaces with one-line page
+;;   number references that look like "(p.1)", right-justified).  The file is
+;;   never modified, and you can see the raw ASCII text by pressing `t'.
+
+;; System Requirements:
+;;
+;;   The `rfcview.el' package was first written using FSF GNU Emacs 20.7 on a
+;;   GNU/Linux system, and is now maintained under Emacs 21.4.  It should work
+;;   with recent Emacs versions on Unix variants.  `rfcview.el' has not yet
+;;   been tested with the XEmacs fork of Emacs, and I'd welcome any necessary
+;;   patches.
+
+;; Installation:
+;;
+;;   1. Put this `rfcview.el' file somewhere in your Emacs Lisp load path.
+;;
+;;   2. Add the following lines to your `~/.emacs' file:
+;;
+;;          (add-to-list 'auto-mode-alist
+;;                       '("/\\(rfc\\|std\\)[0-9]+\\.txt\\'" . rfcview-mode))
+;;
+;;          (autoload 'rfcview-mode "rfcview" nil t)
+;;
+;;      The next time you visit an RFC file, it should be
+;;      displayed prettily using `rfcview-mode'.  (Do this before turning
+;;      on `auto-compression-mode', so that the `.gz' extension comes before
+;;      `.txt' in `auto-mode-alist'; then compressed RFCs will work too.)
+;;
+;;   4. Optionally, do `M-x rfcview-customize RET' to customize the mode
+;;      options.
+
+;; Things for the Author to Someday Do (but Probably Not):
+;;
+;;   * RFC 1700 (STD 2) has unnumbered headings and column-zero body text.  We
+;;     don't try to cope right now, but we might assume, e.g., that lines in
+;;     all-caps with preceding and succeeding blank lines are headings.
+;;
+;;   * Hide extraneous blank lines.
+;;
+;;   * Handle "Table of Contents" heading centered, such as in RFC 1035 and RFC
+;;     1157.
+;;
+;;   * Display bibliographic references in other-window
+;;     vertically-sized to fit only the reference (or min window height).
+;;
+;;   * Download RFCs on demand, and cache them.  Probably integrate one of the
+;;     existing one or two packages that do this.
+;;
+;;   * Make an RFCedit mode.
+;;
+;;   * Handle multi-line heading like:
+;;
+;;         19.6.1.1 Changes to Simplify Multi-homed Web Servers and Conserve IP
+;;         Addresses
+;;
+;;   * Have a stack for (internal) hyperlinks a la Info.
+;;
+;;   * Deal with an index (e.g. RFC 3986).
+
+;;; CHANGE LOG:
+
+;; [Version 0.11, 2008-02-02]  (Dave Love)
+;; * rfcview-find-rfc.
+;;
+;; [Version 0.10, 2008-01-28]  (Dave Love)
+;; * Fix rfcview-find-location-of-rfc-mouse interactive spec.
+;; * Get speedbar working.
+;; * Allow list of alternative locations for RFCs.
+;;
+;; [Version 0.9, 2007-10-14]  (Dave Love)
+;; * Fix view-mode require and fix overlay type for reference.
+;;
+;; [Version 0.8, 2007-04-25]  (Dave Love)
+;; * Fix rfcview-overriding-map; modify rfcview-headlink-face for dark b/g.
+;;
+;; [Version 0.7, 2006-10-01]  (Dave Love)
+;; * Use ange-ftp, not browse-url;
+;; * Handle STDs as well as RFCs.
+;;
+;; [Version 0.6, 2006-07-07] Hyperlinking, imenu (Dave Love).
+;;
+;; [Version 0.5, 15-Oct-2002] Updated email address.
+;;
+;; [Version 0.4, 26-Feb-2002]
+;; * Added `rfcview-use-view-mode-p' feature (suggested by Andreas Fuchs).
+;; * Added `.gz' handling to `auto-mode-alist' example for people whose Emacs
+;;   auto-decompression features don't strip the compression extension before
+;;   doing the `auto-mode-alist' lookup.  (thanks to Andreas Fuchs)
+;;
+;; [Version 0.3, 22-Feb-2002]
+;; * Added autoload cookie (suggested by Daniel Pittman).
+
+;; [Version 0.2, 22-Feb-2002]
+;; * Tweaks to support some Internet-Drafts.
+;; * In heading patterns, `.' is now optional after single-integer heading
+;;   numbers, but remains mandatory after alphabetic (appendix) section
+;;   numbers.
+;; * Hides carriage return characters (which is already done in some Emacs
+;;   configurations, but not in others).
+
+;; [Version 0.1, 17-Mar-2001] Initial release.  Note that there's some
+;; hyperlink-related code, but it's not finished, so pretend it's not there --
+;; but the static reformatting stuff works and is useful, and I can't spend any
+;; more time on this package in the near future, so I'm releasing the package
+;; now.
+
+;;; CODE:
+
+(require 'goto-addr)
+(require 'view)
+
+;; Customization:
+
+(defgroup rfcview nil
+  "View IETF RFC files with formatting."
+  :group  'hypermedia
+  :prefix "rfcview-")
+
+(defcustom rfcview-mode-hook nil
+  "Hook variable for `rfcview-mode'."
+  :group 'rfcview
+  :type  'hook)
+
+(defcustom rfcview-use-view-mode-p t
+  "If non-nil, start `view-mode' when `rfcview-mode' is started."
+  :group 'rfcview
+  :type  'boolean)
+
+;; Note that this is also defined by `ffap-rfc-path', though Emacs
+;; 21's value of that is wrong, and we probably don't want to require
+;; ffap.
+;; Fixme: This should be a path, e.g. local directory plus rfc-editor site.
+(defcustom rfcview-rfc-location-pattern
+  "/ftp@ftp.rfc-editor.org:/in-notes/rfc%s.txt"
+  "Pattern to generate the location of a numbered RFC.
+Must contain a single `%s' to be substituted with the RFC's number.
+On a Debian-style system, with the doc-rfc packages installed, this could be
+\"/usr/share/doc/RFC/links/rfc%s.txt.gz\" to read local copies.
+A list of such patterns is also valid; its elements are tried in order
+to find the RFC.  Typically you want to try a local directory first and
+then the IETF site.  If you have installed suitable file handlers, e.g.
+with `url-handler-mode', you can use arbitrary URL patterns.
+See also `rfcview-std-location-pattern'."
+  :type '(choice string (repeat string))
+  :group 'rfcview)
+
+(defcustom rfcview-std-location-pattern
+  "/ftp@ftp.rfc-editor.org:/in-notes/std/std%s.txt"
+  "Pattern to generate the location of a numbered STD.
+Must contain a single `%s' to be substituted with the STD's number.
+A list of such patterns is also valid; its elements are tried in order
+to find the RFC.  Typically you want to try a local directory first and
+then the IETF site.  See also `rfcview-rfc-location-pattern'."
+  :type '(choice string (repeat string))
+  :group 'rfcview)
+
+(defcustom rfcview-index-location
+  (if (consp rfcview-rfc-location-pattern)
+      (mapcar (lambda (elt)
+		(replace-regexp-in-string "%s.txt" "-index.txt" elt))
+	      rfcview-rfc-location-pattern)
+    (replace-regexp-in-string "%s.txt" "-index.txt"
+			      rfcview-rfc-location-pattern))
+  "Location, or list of locations in which to find the RFC index.
+The index is usually rfc-index.txt in the RFC directory."
+  :group 'rfcview
+  :type '(choice string (repeat string))
+  :set-after '(rfcview-rfc-location-pattern))
+
+(defface rfcview-title-face
+  '((t (:bold t)))
+  "Face used for titles."
+  :group 'rfcview)
+
+(defface rfcview-headname-face
+  '((t (:bold t :underline t)))
+  "Face used for heading names."
+  :group 'rfcview)
+
+(defface rfcview-headnum-face
+  '((t (:bold t)))
+  "Face used for heading numbers."
+  :group 'rfcview)
+
+(defface rfcview-headlink-face
+  '((((type tty pc) (class color)) (:foreground "blue" :weight light))
+    (((class color) (background light)) (:foreground "blue"))
+    (((class color) (background dark)) (:foreground "LightSkyBlue"))
+    (t (:bold t)))
+  "Face used for hyperlinks to headings."
+  :group 'rfcview)
+
+(defface rfcview-mouseover-face
+  '((t (:inherit highlight)))
+  "Face used for mousing over a hyperlink."
+  :group 'rfcview)
+
+(defface rfcview-rfcnum-face
+  '((t (:bold t)))
+  "Face used for RFC number in the header."
+  :group 'rfcview)
+
+(defface rfcview-stdnum-face
+  '((t (:bold t)))
+  "Face used for STD number in the header."
+  :group 'rfcview)
+
+;; Global Variables:
+
+(defvar rfcview-debug-show-hidden-p nil)
+
+(defvar rfcview-mode-map
+  (let ((km (make-sparse-keymap)))
+    (define-key km "t" 'rfcview-textmode)
+    (define-key km "q" 'rfcview-quit)
+    (define-key km "\t" 'rfcview-next-button)
+    (easy-menu-define rfcview-mode-menu km
+      "Menu for RFCview."
+      '("RFCview"
+	["Quit"      rfcview-quit     t]
+	["Text Mode" rfcview-textmode t]
+	["Next Button" rfcview-next-button t]))
+    km))
+
+(defvar rfcview-stock-section-names
+  '("abstract"
+    "acknowledgement"
+    "acknowledgements"
+    "acknowledgment"
+    "acknowledgments"
+    "appendices"
+    "author's address"
+    "authors' addresses"
+    "bibliography"
+    "chair's address"
+    "copyright notice"
+    "copyright statement"
+    "editor's address"
+    "editors' addresses"
+    "full copyright notice"
+    "full copyright statement"
+    "iesg note"
+    "index"
+    "introduction"
+    "references and bibliography"
+    "references"
+    "security considerations"
+    "status of this memo"
+    "table of contents"
+    "informative references"
+    "normative references"))
+
+(defvar rfcview-headlink-ovlcat nil)
+(defvar rfcview-headname-ovlcat nil)
+(defvar rfcview-headnum-ovlcat  nil)
+(defvar rfcview-hide-ovlcat     nil)
+(defvar rfcview-pagenum-ovlcat  nil)
+(defvar rfcview-title-ovlcat    nil)
+
+;; Buffer-Local Variables:
+
+(defvar rfcview-local-heading-alist nil)
+
+(defvar rfcview-ref-alist nil
+  "Alist of RFC references `( . )'.")
+
+;; Functions:
+
+(defun rfcview-add-overlay (begin end category)
+  (unless category (error "rfcview-add-overlay nil category"))
+  (let ((overlay (make-overlay begin end)))
+    (overlay-put overlay 'category category)
+    overlay))
+
+;;;###autoload
+(defun rfcview-customize ()
+  "Enter the RFCview Custom group."
+  (interactive)
+  (customize-group 'rfcview))
+
+(defun rfcview-grok-buffer ()
+  "Add overlays to the buffer to modify its presentation."
+  (interactive)
+  (let ((case-fold-search nil)
+        (top-point        (point-min))
+        (title-line-point nil))
+    
+    ;; Clean up everything.
+    (rfcview-remove-all-overlays)
+    (make-local-variable 'rfcview-local-heading-alist)
+    (setq rfcview-local-heading-alist '())
+
+    ;; Hide any CRs.
+    (goto-char (point-min))
+    (while (re-search-forward "\r+" nil t)
+      (rfcview-hide-region (match-beginning 0) (match-end 0)))
+
+    ;; Add hiding overlay for whitespace at start of file, and set `top-point'
+    ;; to just after it.
+    (goto-char (point-min))
+    (when (re-search-forward "\\`\\([ \t\f]*\r?\n\\)+" nil t)
+      (rfcview-hide-region (match-beginning 0) (match-end 0))
+      (setq top-point (point)))
+    
+    ;; Add overlays for page headers and footers.
+    (let ((headerfooter-re (concat "^[ \t]*"
+                                   "\\(\r?\n\\)"         ; #1
+                                   "\\([ \t]*\r?\n\\)*"  ; #2
+                                   "[^ \t\f].*\\[Page "
+                                   "\\([0-9iIvVxX]+\\)"  ; #3
+                                   "\\][ ]*\r?\n?"
+                                   "\\("                 ; <#4
+                                   "\f"
+                                   "\\([ \t]*\r?\n\\)?"  ; #5
+                                   "\\("                 ; <#6
+                                   "\\("                 ; <#7
+                                   "RFC [0-9]+"
+                                   "\\|"                 ; |#7
+                                   "Internet-Draft[ \t]"
+                                   "\\)"                 ; >#7
+                                   ".*\r?\n"
+                                   "\\([ \t]*\r?\n\\)*"  ; #8
+                                   "\\)?"                ; >#6
+                                   "\\)?"                ; >#4
+                                   )))
+      (while (re-search-forward headerfooter-re nil t)
+        (rfcview-hide-region (match-end 1) (match-end 0))
+        (when (match-beginning 6)
+          (let ((overlay  (rfcview-add-overlay (match-beginning 1)
+                                               (match-end 1)
+                                               'rfcview-pagenum-ovlcat))
+                ;; Note: If we wanted to do this right, we would save a marker
+                ;;       and then backpatch once we see the next page footer.
+                (page-str (format
+                           "(p.%s)"
+                           (let ((n (string-to-number (match-string 3))))
+                             (if (= n 0) "?" (1+ n))))))
+            (overlay-put overlay
+                         'before-string
+                         (concat (make-string (max (- 79
+                                                      (- (match-beginning 1)
+                                                         (match-beginning 0))
+                                                      (length page-str))
+                                                   0)
+                                              32)
+                                 page-str))))))
+
+    ;; Find the first blank line (which should be between top headers and
+    ;; before title), remember point, and hide any extraneous blank lines.
+    (goto-char top-point)
+    (unless (re-search-forward (concat "^[ \t]*\r?\n"
+                                       "\\(\\([ \t]*\r?\n\\)+\\)?")
+                               nil t)
+      (error "This doesn't seem to be an RFC - no blank line before title"))
+    (when (match-beginning 1)
+      (rfcview-hide-region (match-beginning 1) (match-end 1)))
+    (setq title-line-point (point))
+
+    ;; Add overlay for the RFC number.
+    (goto-char top-point)
+    (when (let ((case-fold-search t))
+            (re-search-forward "^request for comments:[ \t]+\\([0-9X]+\\)"
+                               title-line-point t))
+      (rfcview-add-overlay (match-beginning 1)
+                           (match-end 1)
+                           'rfcview-rfcnum-ovlcat))
+
+    ;; Add overlay for the STD number.
+    (goto-char top-point)
+    (when (let ((case-fold-search nil))
+            (re-search-forward "^STD:[ \t]+[0-9]+"
+                               title-line-point t))
+      (rfcview-add-overlay (match-beginning 0)
+                           (match-end 0)
+                           'rfcview-stdnum-ovlcat))
+
+    ;; Add overlays to the title line(s).  Note that we currently assume no
+    ;; blank lines in the title; otherwise we have to do a perfect job of
+    ;; identifying the first non-title line (usually a section heading, which
+    ;; some some RFCs make difficult to always identify).
+    (goto-char title-line-point)
+    (if (re-search-forward (concat
+                            "\\([^ \t\f\r\n].*[^ \t\f\r\n]\\)"
+                            "\\(\r?\n[ \t]*[^ \t\f\r\n].*[^ \t\f\r\n]\\)*"))
+        (rfcview-add-overlay (match-beginning 0)
+                             (match-end       0)
+                             'rfcview-title-ovlcat))
+
+    ;; Find all the headings.  Add overlays for them, and build
+    ;; `rfcview-local-heading-alist'.
+    (goto-char title-line-point)
+    (let ((case-fold-search t)
+          ;; Note: We can't just look for lines that begin in column 0, since
+          ;; some RFCs put source code, ASCII-art, description list headings,
+          ;; body text, and other stuff in column 0.  So we look for stock
+          ;; headings and ones that appear to begin with section numbers.
+          (heading-re (concat
+                       "^"
+                       "\\("                     ; <#1
+                       "\\("                     ; <#2 = numbered section
+                       "\\("                     ; <#3 = number
+                       "\\([0-9]+\\.?\\|[A-Z]\\.\\)" ; #4
+                       "\\([0-9]+\\.?\\)*"       ; #5
+                       "\\)"                     ; >#3 = number
+                       "[ \t]+"
+                       "\\([^\r\n]+\\)"          ; #6 = name
+                       "\\)"                     ; >#2 = numbered section
+                       "\\|"                     ; |#1
+                       "\\("                     ; <#7 = stock section
+                       "\\("                     ; <#8
+                       (mapconcat 'identity rfcview-stock-section-names "\\|")
+                       "\\)"                     ; >#8
+                       ":?[ \t]*$"
+                       "\\)"                     ; >#7 = stock section
+                       "\\|"                     ; |#1
+                       "\\("                     ; <#9 = lit-appendix
+                       
+                       "appendix[ \t]+"
+                       "\\([A-Z]\\)"             ; #10 = number
+                       
+                       "\\(\\.\\|:\\|[ \t]+-\\)" ; #11
+                       "[ \t]+"
+                       "\\([^\r\n]+\\)"          ; #12 = name
+
+                       "\\)"                     ; >#9 = lit-appendix
+                       "\\)"                     ; >#1
+                       )))
+      (while (re-search-forward heading-re nil t)
+        (let ((num-match           nil)
+              (num-highlight-begin nil)
+              (num-highlight-end   nil)
+              (name-match          nil))
+          ;; Get the match data numbers.
+          (cond ((match-beginning 3) (setq num-match  3
+                                           name-match 6))
+                ((match-beginning 8) (setq num-match  nil
+                                           name-match 8))
+                ((match-beginning 9) (setq num-match  10
+                                           name-match 12)
+                 (setq num-highlight-begin (match-beginning 9)
+                       num-highlight-end   (match-end       11)))
+                (t (error "This should never happen")))
+
+	  ;; Don't lose if author's initial used in page footer.
+	  (unless (save-match-data
+		    (string-match "[[]Page [0-9iIvVxX]+]\\'"
+				  (match-string name-match)))
+	    ;; Add overlays.
+	    (when num-match
+	      (rfcview-add-overlay (or num-highlight-begin
+				       (match-beginning num-match))
+				   (or num-highlight-end
+				       (match-end       num-match))
+				   'rfcview-headnum-ovlcat))
+	    (rfcview-add-overlay (match-beginning name-match)
+				 (match-end       name-match)
+				 'rfcview-headname-ovlcat)
+	    ;; Prepend the `rfcview-local-heading-alist' entry.
+	    (let ((num  (when num-match
+			  (upcase (match-string-no-properties num-match))))
+		  (name (match-string-no-properties name-match)))
+	      (push (cons (downcase (or num name))
+			  (vector
+			   num
+			   name
+			   (match-beginning 0)
+			   (match-end 0)))
+		    rfcview-local-heading-alist))))))
+    ;; Reverse `rfcview-local-heading-alist'.
+    (setq rfcview-local-heading-alist (nreverse rfcview-local-heading-alist))
+
+    ;; Hyperlink the contents and references
+    (rfcview-hyperlink-contents)
+    (rfcview-hyperlink-refs)
+
+    ;; Hyperlink URLs.  `goto-address-fontify-maximum-size' is only
+    ;; 30000 by default.
+    (let ((goto-address-fontify-maximum-size (point-max))
+	  (goto-address-highlight-p t)
+	  (goto-address-mail-regexp "\\<\\>")) ; don't match emails
+      (goto-address))
+
+    ;; Leave the point at the visible top of the buffer.
+    (goto-char top-point))
+  
+  (message "This RFC has been reformatted for viewing in Emacs."))
+
+(defun rfcview-hide-region (start end)
+  (rfcview-add-overlay start end 'rfcview-hide-ovlcat))
+
+;; Hyperlinking
+
+(defun rfcview-imenu-index-function ()
+  "`imenu-create-index-function' for RFCview."
+  (mapcar (lambda (elt)
+	    (setq elt (cdr elt))
+	    (let ((num (aref elt 0))
+		  (head (aref elt 1))
+		  (pos (aref elt 2)))
+	      (cons (if num
+			(concat num " " head)
+		      head)
+		    pos)))
+	  rfcview-local-heading-alist))
+
+(defun rfcview-link-add-headlink (start end pos)
+  (let ((overlay (rfcview-add-overlay start end 'rfcview-headlink-ovlcat)))
+    (overlay-put overlay 'rfcview-link (list 'head pos))
+    overlay))
+
+(defun rfcview-link-add-headlink-for (start end key)
+  (let ((vec (cdr (assoc (downcase key) rfcview-local-heading-alist))))
+    (when vec
+      (rfcview-link-add-headlink start end (aref vec 2)))))
+
+(defun rfcview-hyperlink-contents ()
+  "Find table of contents and hyperlink the entries to headers."
+  (let* ((elt (assoc "table of contents" rfcview-local-heading-alist))
+	 (start (if elt (aref (cdr elt) 3)))
+	 (next (cadr (member elt rfcview-local-heading-alist)))
+	 (end (if next (aref (cdr next) 2)))
+	 (case-fold-search t))
+    (when (and start end)
+      (save-excursion
+	(save-restriction
+	  (narrow-to-region start end)
+	  (goto-char (point-min))
+	  (dolist (elt rfcview-local-heading-alist)
+	    (let ((key (car elt)))
+	      (when (re-search-forward (concat "^ *\\(" (regexp-quote key)
+					       "\\) ")
+				       nil t)
+		(rfcview-link-add-headlink-for (match-beginning 1)
+					       (line-end-position)
+					       key)
+		(end-of-line)))))))))
+
+(defvar rfcview-link-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map [mouse-2] #'rfcview-goto-link-mouse)
+    map)
+  "Keymap for use on link overlays.")
+
+(defvar rfcview-overriding-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map "\C-m" #'rfcview-maybe-goto-link)
+    (set-keymap-parent map view-mode-map)
+    map)
+  "Keymap binding RET to override the View mode binding.")
+
+(defun rfcview-maybe-goto-link ()
+  "Follow link if on one, else use normal binding of RET.
+Push mark if on a link."
+  (interactive)
+  (or (rfcview-goto-link)
+      (rfcview-find-location-of-rfc)
+      (if (get-char-property (point) 'goto-address) ; URL found by goto-addr
+	  (goto-address-at-point))
+      ;; Use the binding that's presumably from View mode:
+      (let ((minor-mode-overriding-map-alist nil))
+	(call-interactively (key-binding [?\C-m])))))
+
+(defun rfcview-goto-link ()
+  "If on a link, go to target, push mark, and return non-nil.
+Else return nil."
+  (interactive)
+  (let ((pos (cadr (get-char-property (point) 'rfcview-link))))
+    (when pos
+      (push-mark)
+      (goto-char pos))))
+
+(defun rfcview-goto-link-mouse (event)
+  "Follow a link selected with the mouse EVENT and push mark."
+  (interactive "e")
+  (mouse-set-point event)
+  (rfcview-goto-link))
+
+(defun rfcview-hyperlink-refs ()
+  "Find references in appropriate sections and hyperlink them from elsewhere."
+  (save-excursion
+    ;; Find the references sections, including `Normative
+    ;; references' &c.
+    (dolist (elt rfcview-local-heading-alist)
+      (when (let ((case-fold-search t))
+	      (string-match "\\<\\(?:references\\|bibliography\\)\\'"
+			    (aref (cdr elt) 1)))
+	(let* ((start (aref (cdr elt) 3))
+	       (next (cadr (member elt rfcview-local-heading-alist)))
+	       (end (if next
+			(aref (cdr next) 2)
+		      (point-max)))
+	       (case-fold-search nil))
+	  (save-restriction
+	    (narrow-to-region start end)
+	    (goto-char (point-min))
+	    ;; Look for plausible-looking tags (with uppercase
+	    ;; letters, numbers or hyphens within brackets).
+	    (while (re-search-forward "^ *\\([[][-A-Z0-9]+]\\) " nil t)
+	      (push (cons (match-string 1) (match-beginning 1))
+		    rfcview-ref-alist)
+	      ;; If it looks like an RFC reference, hyperlink it.
+	      (let ((start (match-beginning 1))
+		    (end (match-end 1))
+		    (string (match-string 1)))
+		(when (string-match "[[]\\(RFC\\|STD\\)\\([0-9]+\\)]" string)
+		  (let ((overlay (make-overlay start end)))
+		    (overlay-put overlay 'category 'rfcview-rfcurl-ovlcat)
+		    (overlay-put overlay 'location
+				 (if (equal "RFC" (match-string 1 string))
+				     (mapcar
+				      (lambda (x)
+					(format x (match-string 2 string)))
+				      (if (listp rfcview-rfc-location-pattern)
+					  rfcview-rfc-location-pattern
+					(list rfcview-rfc-location-pattern)))
+				   (mapcar
+				    (lambda (x)
+				      (format x (match-string 2 string)))
+				    (if (listp rfcview-std-location-pattern)
+					rfcview-std-location-pattern
+				      (list rfcview-std-location-pattern)))))))))))))
+    ;; Find and activate references in the body.  Skip if it's at the
+    ;; position of a target.
+    (goto-char (point-min))
+    (while (re-search-forward "\\([[][-A-Z0-9]+]\\)" nil t)
+      (let ((elt (assoc (match-string 1) rfcview-ref-alist)))
+	(when (and elt (/= (match-beginning 1) (cdr elt)))
+	  (overlay-put (rfcview-add-overlay (match-beginning 1) (match-end 1)
+					    'rfcview-reflink-ovlcat)
+		       'rfcview-link (list 'ref (cdr elt))))))))
+
+(defun rfcview-find-internal (files &optional sort mode)
+  "Find the first of FILES which exists.
+FILES may be a list or a single file."
+  (catch 'found
+    (dolist (file files)
+      (when (file-exists-p file)
+	(let (text-mode-hook)		; don't run Flyspell etc.
+	  (find-file file))
+	(throw 'found t)))
+    (error "%s not found: %s" (or sort "RFC")
+	   (mapconcat #'identity files ", ")))
+  (if (and mode (not (eq major-mode 'rfcview-mode)))
+    (rfcview-mode)))
+
+;;;###autoload
+(defun rfcview-find-rfc (number)
+  "Find RFC NUMBER and view it in RFcview mode.
+Interactively, prompt for the number.
+See `rfcview-rfc-location-pattern' for where to search."
+  (interactive  (rfcview-prompt-number))
+  (rfcview-find-internal (mapcar
+			  (lambda (x)
+			    (format x number))
+			  (if (listp rfcview-rfc-location-pattern)
+			      rfcview-rfc-location-pattern
+			    (list rfcview-rfc-location-pattern)))
+			 nil t))
+
+(defun rfcview-prompt-number ()
+  (let* ((n (number-at-point))
+	 (val (read-string "RFC number: " (if n (number-to-string n)) nil n)))
+    (if (> (length val) 0)
+	(list (string-to-number val))
+      (error "Missing number"))))
+
+(defun rfcview-find-location-of-rfc ()
+  "Browse to the LOCATION of any RFC referenced at point."
+  (interactive)
+  (rfcview-find-internal (get-char-property (point) 'location) nil t))
+
+(defun rfcview-find-location-of-rfc-mouse (event)
+  "Browse to the LOCATION of the RFC reference at the mouse EVENT."
+  (interactive "e")
+  (save-excursion
+    (mouse-set-point event)
+    (rfcview-find-location-of-rfc)))
+
+(defvar rfcview-rfc-keymap
+  (let ((map (make-sparse-keymap)))
+    (define-key map [mouse-2] #'rfcview-find-location-of-rfc-mouse)
+    (define-key map [?\C-m] #'rfcview-find-location-of-rfc)
+    map)
+  "Keymap for links to RFC locations.")
+
+;;;###autoload
+(defun rfcview-find-index ()
+  "Find the RFC index and hyperlink it."
+  (interactive)
+  (rfcview-find-internal (if (listp rfcview-index-location)
+			     rfcview-index-location
+			   (list rfcview-index-location))
+			 "RFC index")
+  (view-mode)
+  (save-excursion
+    (goto-char (point-min))
+    (when (= (point-max)
+	     (next-single-char-property-change (point) 'rfcview-rfcnum-ovlcat))
+      (let ((pattern (if (listp rfcview-rfc-location-pattern)
+			 rfcview-rfc-location-pattern
+		       (list rfcview-rfc-location-pattern))))
+      (while (re-search-forward "^\\([0-9]\\{4\\}\\) " nil t)
+	(let ((start (match-beginning 1)))
+	  (let ((overlay (make-overlay start (line-end-position))))
+	    (overlay-put overlay 'category 'rfcview-rfcurl-ovlcat)
+	    (overlay-put overlay 'location
+			 (mapcar (lambda (x)
+				   (format x (match-string 1)))
+				 pattern)))
+	  (rfcview-add-overlay start (match-end 1)
+			       'rfcview-rfcnum-ovlcat)))))))
+
+;; Major mode
+
+;;;###autoload
+(defun rfcview-mode ()
+  "Major mode for viewing Internet RFCs.
+
+http://www.loveshack.ukfsn.org/emacs/rfcview.el
+http://www.neilvandyke.org/rfcview/
+
+Key bindings:
+\\{rfcview-mode-map}"
+  (interactive)
+  (kill-all-local-variables)
+  (setq major-mode 'rfcview-mode)
+  (setq mode-name "RFCview")
+  (use-local-map rfcview-mode-map)
+  (make-local-variable 'font-lock-defaults)
+  (make-local-variable 'rfcview-local-heading-alist)
+  (setq font-lock-defaults nil)
+  ;; Arrange to lose the C-m binding from View mode:
+  (push (cons 'view-mode rfcview-overriding-map)
+	minor-mode-overriding-map-alist)
+  (set (make-local-variable 'imenu-create-index-function)
+       'rfcview-imenu-index-function)
+  (set (make-local-variable 'imenu-sort-function) nil)
+  (make-local-variable 'rfcview-ref-alist)
+  (when rfcview-use-view-mode-p
+    (view-mode-enter nil #'rfcview-quit))
+  (rfcview-grok-buffer)
+  ;; This is easier and probably better than inserting contents in the
+  ;; mode menu.
+  (imenu-add-to-menubar "Contents")
+  (run-hooks 'rfcview-mode-hook))
+
+(defun rfcview-put-alist (symbol alist)
+  (mapcar (function (lambda (cell)
+                      (put symbol (nth 0 cell) (cdr cell))))
+          alist))
+
+(defun rfcview-quit (&optional buffer)
+  "Kill the RFCview buffer.
+Arg BUFFER is ignored."
+  (interactive)
+  (kill-buffer (current-buffer)))
+
+(defun rfcview-remove-all-overlays ()
+  (mapcar (function (lambda (lst)
+                      (while lst
+                        (delete-overlay (car lst))
+                        (setq lst (cdr lst)))))
+          (let ((lists (overlay-lists)))
+            (list (car lists) (cdr lists)))))
+
+(defun rfcview-textmode ()
+  "Remove overlays from the buffer and put it into Text mode."
+  (interactive)
+  (rfcview-remove-all-overlays)
+  (text-mode))
+
+(defun rfcview-next-button ()
+  "Move point to the next \"button\" (active link)."
+  (interactive)
+  (if (get-char-property (point) 'keymap) ; move off it
+      (goto-char (next-single-char-property-change (point) 'keymap)))
+  (goto-char (next-single-char-property-change (point) 'keymap)))
+
+;; Overlay Categories:
+
+(rfcview-put-alist 'rfcview-hide-ovlcat
+                   (if rfcview-debug-show-hidden-p
+                       '((face       . region)
+                         (intangible . nil)
+                         (invisible  . nil))
+                     '((face       . default)
+                       (intangible . t)
+                       (invisible  . t))))
+
+(rfcview-put-alist 'rfcview-headname-ovlcat '((face . rfcview-headname-face)))
+(rfcview-put-alist 'rfcview-headnum-ovlcat  '((face . rfcview-headnum-face)))
+(rfcview-put-alist 'rfcview-rfcnum-ovlcat   '((face . rfcview-rfcnum-face)))
+(rfcview-put-alist 'rfcview-stdnum-ovlcat   '((face . rfcview-stdnum-face)))
+(rfcview-put-alist 'rfcview-title-ovlcat    '((face . rfcview-title-face)))
+
+(rfcview-put-alist 'rfcview-headlink-ovlcat
+                   `((face       . rfcview-headlink-face)
+                     (mouse-face . rfcview-mouseover-face)
+		     (keymap . ,rfcview-link-map)
+		     (help-echo . "mouse-2, C-m: go to section")))
+(rfcview-put-alist 'rfcview-reflink-ovlcat
+                   `((face       . rfcview-headlink-face)
+                     (mouse-face . rfcview-mouseover-face)
+		     (keymap . ,rfcview-link-map)
+		     (help-echo . "mouse-2, C-m: follow reference")))
+
+(rfcview-put-alist 'rfcview-rfcurl-ovlcat
+		   `((face . ,goto-address-url-face)
+		     (mouse-face . ,goto-address-url-mouse-face)
+		     (help-echo . "mouse-2, C-m: browse RFC's location")
+		     (keymap . ,rfcview-rfc-keymap)))
+
+;; This persuades speedbar to use Imenu with RRCs.
+(eval-after-load "speedbar"
+  '(speedbar-add-supported-extension '("rfc[0-9]+\.txt\.gz" "rfc[0-9]+\.txt")))
+
+;; End:
+
+(provide 'rfcview)
+
+;;; rfcview.el ends here
diff --git a/elisp/emacs-goodies-el/services.el b/elisp/emacs-goodies-el/services.el
new file mode 100755
index 0000000..029b505
--- /dev/null
+++ b/elisp/emacs-goodies-el/services.el
@@ -0,0 +1,184 @@
+;;; services.el --- Services database access functions.
+;; Copyright 2000-2008 by Dave Pearson 
+;; $Revision: 1.4 $
+
+;; services.el is free software distributed under the terms of the GNU
+;; General Public Licence, version 2 or (at your option) any later version.
+;; For details see the file COPYING.
+
+;;; Commentary:
+;;
+;; services.el provides a set of functions for accessing the services
+;; details list.
+;;
+;; The latest services.el is always available from:
+;;
+;;   
+
+;;; BUGS:
+;;
+;; o Large parts of this code look like large parts of the code you'll find
+;;   in protocols.el, this is unfortunate and makes me cringe. However, I
+;;   also wanted them to be totally independant of each other. Suggestions
+;;   of how to sweetly remedy this situation are welcome.
+
+;;; INSTALLATION:
+;;
+;; o Drop services.el somwehere into your `load-path'. Try your site-lisp
+;;   directory for example (you might also want to byte-compile the file).
+;;
+;; o Add the following autoload statement to your ~/.emacs file:
+;;
+;;   (autoload 'services-lookup      "services" "Perform a service lookup" t)
+;;   (autoload 'services-clear-cache "services" "Clear the service cache"  t)
+
+;;; Code:
+
+;; Things we need:
+
+(eval-when-compile
+  (require 'cl))
+
+;; Customisable variables.
+
+(defvar services-file "/etc/services"
+  "*Name of the services file.")
+
+;; Non-customize variables.
+
+(defvar services-cache nil
+  "\"Cache\" of services.")
+
+(defvar services-name-cache nil
+  "\"Cache\" of service names.")
+
+;; Main code:
+
+(defsubst service-name (service)
+  "Get the name of service SERVICE."
+  (car service))
+
+(defsubst service-port (service)
+  "Get the port of service SERVICE."
+  (cadr service))
+
+(defsubst service-protocols (service)
+  "Get the protocols of service SERVICE."
+  (car (cddr service)))
+
+(defsubst service-aliases (service)
+  "Get the aliases for service SERVICE."
+  (cadr (cddr service)))
+
+(defun services-line-to-list (line)
+  "Convert LINE from a string into a structured service list."
+  (let* ((words (split-string line))
+         (port (split-string (cadr words) "/")))
+    (list
+     (car words)
+     (string-to-int (car port))
+     (list (cadr port))
+     (loop for s in (cddr words)
+           while (not (= (aref s 0) ?#))
+           collect s))))
+
+(defun* services-read (&optional (file services-file))
+  "Read the services list from FILE.
+
+If FILE isn't supplied the value of `services-file' is used."
+  (or services-cache
+      (setq services-cache
+            (when (file-readable-p file)
+              (with-temp-buffer
+                (insert-file-contents file)
+                (setf (point) (point-min))
+                (let ((services (list)))
+                  (loop for service in
+                        (loop until (eobp)
+                              do (setf (point) (line-beginning-position))
+                              unless (or (looking-at "^[ \t]*#") (looking-at "^[ \t]*$"))
+                              collect (services-line-to-list (buffer-substring (line-beginning-position) (line-end-position)))
+                              do (forward-line))
+                        do (let ((hit (assoc (service-name service) services)))
+                             (if (and hit (= (service-port hit) (service-port service)))
+                                 (setf (cdr hit) (list
+                                                  (service-port hit)
+                                                  (append (service-protocols hit) (service-protocols service))
+                                                  (service-aliases hit)))
+                               (push service services)))
+                        finally return (reverse services))))))))
+      
+(defun* services-find-by-name (name &optional (protocol "tcp") (services (services-read)))
+  "Find the service whose name is NAME."
+  (loop for service in services
+        when (and (string= (service-name service) name)
+                  (member protocol (service-protocols service)))
+        return service))
+
+(defun* services-find-by-port (port &optional (protocol "tcp") (services (services-read)))
+  "Find the service whose port is PORT."
+  (loop for service in services
+        when (and (= (service-port service) port)
+                  (member protocol (service-protocols service)))
+        return service))
+
+(defun* services-find-by-alias (alias &optional (protocol "tcp") (services (services-read)))
+  "Find a the service whose with an alias of ALIAS."
+  (loop for service in services
+        when (and (member alias (service-aliases service))
+                  (member protocol (service-protocols service)))
+        return service))
+
+;;;###autoload
+(defun services-lookup (search protocol)
+  "Find a service and display its details."
+  (interactive (list
+                (completing-read "Service Search: "
+                                 (or services-name-cache
+                                     (setq services-name-cache
+                                           (loop for service in (services-read)
+                                                 collect (list (service-name service))
+                                                 append (loop for alias in (service-aliases service)
+                                                              collect (list alias)))))
+                                 nil nil "" nil)
+                (completing-read "Protocol: " '(("tcp") ("udp")) nil nil "tcp" nil)))
+  (let* ((services (services-read))
+         (service (or (when (string-match "^[0-9]+$" search)
+                        (services-find-by-port (string-to-int search) protocol services))
+                      (services-find-by-name search protocol services)
+                      (services-find-by-name (downcase search) protocol services)
+                      (services-find-by-name (upcase search) protocol services)
+                      (services-find-by-alias search protocol services)
+                      (services-find-by-alias (downcase search) protocol services)
+                      (services-find-by-alias (upcase search) protocol services))))
+    (if service
+        (let ((aliases (service-aliases service))
+              (protocols (service-protocols service)))
+          (message "Service: %s  Port: %d  %s%s"
+                   (service-name service)
+                   (service-port service)
+                   (if aliases
+                       (format "Aliases: %s"
+                               (with-output-to-string
+                                   (loop for alias in (service-aliases service)
+                                         do (princ alias) (princ " "))))
+                     "")
+                   (if protocols
+                       (format "%sProtocols: %s"
+                               (if aliases " " "")
+                               (with-output-to-string
+                                   (loop for protocol in protocols
+                                         do (princ protocol) (princ " "))))
+                     "")))
+      (error "No service matching \"%s\" using protocol %s" search protocol))))
+
+;;;###autoload
+(defun services-clear-cache ()
+  "Clear the services \"cache\"."
+  (interactive)
+  (setq services-cache      nil
+        services-name-cache nil))
+
+(provide 'services)
+
+;;; services.el ends here.
diff --git a/elisp/emacs-goodies-el/session.el b/elisp/emacs-goodies-el/session.el
new file mode 100755
index 0000000..0fce7bb
--- /dev/null
+++ b/elisp/emacs-goodies-el/session.el
@@ -0,0 +1,1726 @@
+;;; session.el --- use variables, registers and buffer places across sessions
+
+;; Copyright 1996, 1997, 1998, 1999, 2001, 2002, 2003, 2010
+;; Free Software Foundation, Inc.
+;;
+;; Author: Christoph Wedler 
+;; Version: 2.3 (see also `session-version' below)
+;; Keywords: session, session management, desktop, data, tools
+;; X-URL: http://emacs-session.sourceforge.net/
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3 of the Licence, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see .
+
+;;; Commentary:
+
+;; When you start Emacs, package Session restores various variables (e.g.,
+;; input histories) from your last session.  It also provides a menu
+;; containing recently changed/visited files and restores the places (e.g.,
+;; point) of such a file when you revisit it.
+
+;; For details, check  or, if you prefer
+;; the manual style, the documentation of functions \\[session-save-session]
+;; and `session-store-buffer-places'.
+
+;; Bug fixes, bug reports, improvements, and suggestions for the newest version
+;; are strongly appreciated.
+
+;;; To-do:
+
+;; One could imaging a combination of desktop.el and session.el.  IMHO it is
+;; easier to include the remaining features of desktop.el (load some files at
+;; startup) into session.el, but desktop.el is already part of Emacs...
+;; Anyway, here are some ideas for the combined desktop/session:
+;;
+;;  * Using contexts for buffer positions (idea from bookmark and vc).
+;;  * Define common code with bookmark to restore buffers from a
+;;    file-representation (for files, dired, info buffers).
+;;  * Saving window-configurations?
+
+;;; Installation, private:
+
+;;  1. Make sure to use Emacs-20.2, XEmacs-20.2 or higher.
+;;  2. Put this file into your load-path, i.e. any directory mentioned in the
+;;     value of `load-path'.
+;;  3. Byte-compile this file.
+;;  4. Load this package by M-x load-library RET session RET
+;;  5. Start customization with M-x customize-group RET session RET' or the
+;;     menu [Options][Customize...]...[Data][Session].
+;;  6. Toggle the [Session Use Package] option to "in use".
+;;  7. Save your customization via [Save for future sessions].
+;;  8. If you use both this package and desktop.el, customize the variable
+;;     `desktop-globals-to-save' to include only the symbol
+;;     `desktop-missing-file-warning'.
+
+;; Remark: adding some code to your ~/.emacs like in previous versions of
+;; session.el still works.
+
+;;; Installation, system- or distribution-wide:
+
+;; The idea here should be to offer new defaults to your users (like using this
+;; package), while allowing them to choose otherwise.  This is probably best
+;; done by defining a custom theme (you probably add other customizations to
+;; the custom theme file as well, custom themes might only work with newer
+;; Emacsen):
+
+;;  1. Like 1-3 in the private installation instruction.
+;;  2. Create the autoloads and custom-loads for session.el and make sure that
+;;     they are loaded at Emacs startup.  You can do it manually by adding the
+;;     code below to your site.start.el.
+;;  3. Define a custom theme like `our-custom' by adding a file called
+;;     "our-custom-theme.el" with the code below to a directory in the
+;;     load-path.
+;;  4. Enable your custom theme by adding the code below to your default.el.
+;;  5. Tell your users that they can disable this package by customizing the
+;;     user option according to 5-7 in the private installation instruction or
+;;     by setting `inhibit-default-init' to t.
+
+;; ;; site-start.el, Emacs:
+;; (autoload 'session-jump-to-last-change "session" nil t)
+;; (autoload 'session-initialize "session" nil t)
+;; (eval-after-load "cus-load"
+;;   '(progn (custom-add-load 'data 'session)
+;;           (custom-add-load 'session 'session)))
+
+;; ;; site-start.el, XEmacs:
+;; (autoload 'session-jump-to-last-change "session" nil t)
+;; (autoload 'session-initialize "session" nil t)
+;; (custom-add-load 'data 'session)
+;; (custom-add-load 'session 'session)
+
+;; ;; our-custom-theme.el, Emacs and XEmacs:
+;; (deftheme our-custom "Created 2011-01-15.")
+;; (custom-theme-set-variables
+;;   'our-custom
+;;   '(session-use-package t nil (session)))
+;; (provide-theme 'our-custom)
+
+;; ;; default.el, Emacs:
+;; (enable-theme 'our-custom)
+
+;; ;; default.el, XEmacs:
+;; (require-theme 'our-custom)
+
+;;; Code:
+
+(provide 'session)
+(require 'custom)
+
+;; General Emacs/XEmacs-compatibility compile-time macros
+(eval-when-compile
+  (require 'cl)
+  (defmacro cond-emacs-xemacs (&rest args)
+    (cond-emacs-xemacs-macfn
+     args "`cond-emacs-xemacs' must return exactly one element"))
+  (defun cond-emacs-xemacs-macfn (args &optional msg)
+    (if (atom args) args
+      (and (eq (car args) :@) (null msg) ; (:@ ...spliced...)
+	   (setq args (cdr args)
+		 msg "(:@ ....) must return exactly one element"))
+      (let ((ignore (if (string-match "XEmacs" emacs-version) :EMACS :XEMACS))
+	    (mode :BOTH) code)
+	(while (consp args)
+	  (if (memq (car args) '(:EMACS :XEMACS :BOTH)) (setq mode (pop args)))
+	  (if (atom args)
+	      (or args (error "Used selector %s without elements" mode))
+	    (or (eq ignore mode)
+		(push (cond-emacs-xemacs-macfn (car args)) code))
+	    (pop args)))
+	(cond (msg (if (or args (cdr code)) (error msg) (car code)))
+	      ((or (null args) (eq ignore mode)) (nreverse code))
+	      (t (nconc (nreverse code) args))))))
+  ;; Emacs/XEmacs-compatibility `defun': remove interactive "_" for Emacs, use
+  ;; existing functions when they are `fboundp', provide shortcuts if they are
+  ;; known to be defined in a specific Emacs branch (for short .elc)
+  (defmacro defunx (name arglist &rest definition)
+    (let ((xemacsp (string-match "XEmacs" emacs-version)) reuses first)
+      (while (memq (setq first (car definition))
+		   '(:try :emacs-and-try :xemacs-and-try
+			  :emacs-only :xemacs-only))
+	(if (memq first (if xemacsp
+			    '(:xemacs-and-try :xemacs-only)
+			  '(:emacs-and-try :emacs-only)))
+	    (setq reuses (cadr definition)
+		  definition nil)
+	  (unless (memq first '(:emacs-only :xemacs-only))
+	    (push (cadr definition) reuses)))
+	(setq definition (cddr definition)))
+      (if (and reuses (symbolp reuses))
+	  `(defalias ',name ',reuses)
+	(let* ((docstring (if (stringp (car definition)) (pop definition)))
+	       (spec (and (not xemacsp)
+			  (eq (car-safe (car definition)) 'interactive)
+			  (null (cddar definition))
+			  (cadar definition))))
+	  (if (and (stringp spec)
+		   (not (string-equal spec ""))
+		   (eq (aref spec 0) ?_))
+	      (setq definition
+		    (cons (if (string-equal spec "_")
+			      '(interactive)
+			    `(interactive ,(substring spec 1)))
+			  (cdr definition))))
+	  (if (null reuses)
+	      `(defun ,name ,arglist ,docstring
+		 ,@(cond-emacs-xemacs-macfn definition))
+	    ;; no dynamic docstring in this case
+	    `(eval-and-compile		; no warnings in Emacs
+	       (defalias ',name
+		 (cond ,@(mapcar (lambda (func) `((fboundp ',func) ',func))
+				 (nreverse reuses))
+		       (t ,(if definition
+			       `(lambda ,arglist ,docstring
+				  ,@(cond-emacs-xemacs-macfn definition))
+			     'ignore)))))))))))
+
+(eval-when-compile
+  (defvar put-buffer-names-in-file-menu)
+  (defvar menu-bar-files-menu)
+  (defvar yank-menu)
+  (defvar minibuffer-local-ns-map))
+
+
+
+;;;;##########################################################################
+;;;;  User options, configuration variables
+;;;;##########################################################################
+
+
+(defconst session-version "2.3"
+  "Current version of package session.
+Check  for the newest.")
+
+
+;;;===========================================================================
+;;;  Customization and initialization
+;;;===========================================================================
+
+(defgroup session nil
+  "Use variables, registers and buffer places across sessions."
+  :group 'data
+  :link '(emacs-commentary-link "session.el")
+  :link '(url-link "http://emacs-session.sourceforge.net/")
+  :prefix "session-")
+
+(defgroup session-globals nil
+  "Which variables and registers to save across sessions."
+  :group 'session
+  :prefix "session-")
+
+(defgroup session-places nil
+  "Which places are stored for which buffers."
+  :group 'session
+  :prefix "session-")
+
+(defgroup session-miscellaneous nil
+  "Miscellaneous configurations of package session."
+  :group 'session
+  :prefix "session-")
+
+(defcustom session-initialize t
+  "Whether/what to initialize with function `session-initialize'.
+If t, do full initialization.  Otherwise, the value should be a list
+with element.  To enable, include
+
+ * `de-saveplace' to de-install package saveplace (is redundant),
+ * `session' to load and save the session file,
+ * `places' to store and use places for files/buffers,
+ * `keys' to setup the default key and mouse bindings,
+ * `menus' to setup the menus."
+  :group 'session-miscellaneous
+  :type '(choice (const :tag "All" t)
+		 (set :value (de-saveplace session places keys menus)
+		      (const :tag "De-install saveplace" de-saveplace)
+		      (const :tag "Load/Save Session" session)
+		      (const :tag "Store/Use Places" places)
+		      (const :tag "Setup Key/Mouse Bindings" keys)
+		      (const :tag "Setup Menus" menus))))
+
+
+;;;===========================================================================
+;;;  User Options and Configuration: Menu
+;;;===========================================================================
+
+(defcustom session-menu-max-size 36
+  "*Max number of entries which may appear in the session menus."
+  :group 'session-miscellaneous
+  :type 'integer)
+
+(defcustom session-file-menu-max-string
+  (if (if (boundp 'put-buffer-names-in-file-menu)
+	  put-buffer-names-in-file-menu	; XEmacs
+	nil)				; Emacs: no buffer names in file menu
+      (cons 50 20)
+    50)
+  "*Max length of strings in submenus of the File menu.
+Value has the form MAX or (MAX . NAME-THRESHOLD).  If the second form is
+used and the length returned by `buffer-name' is longer than
+NAME-THRESHOLD, the maximum length will be shortened accordingly.
+
+Deprecated: a negative number -MAX stands for (MAX . 0)."
+  :group 'session-miscellaneous
+  :type '(choice (cons (integer :tag "Max. length" 50)
+		       (integer :tag "Name threshold" 20))
+		 (integer 50)))
+
+(defcustom session-edit-menu-max-string 50
+  "*Max length of strings in submenus of the Edit menu.
+See also `session-compact-yank-gap-regexp'.
+
+When running under Emacs, customize `yank-menu-length' instead."
+  :group 'session-miscellaneous
+  :type 'integer)
+
+(defcustom session-compact-yank-gap-regexp "\\(\n\\|[ \t][ \t][ \t]\\)[ \t\n]*"
+  "*Regexp used when trying to find a gap in a long compact string.
+If non-nil, leading and trailing whitespaces are not shown, and we try
+to find a gap consisting matched by this regexp if we have to split the
+string according to `session-edit-menu-max-string'.
+
+This variable has no effect when running under Emacs."
+  :group 'session-miscellaneous
+  :type 'string)
+
+(defcustom session-menu-permanent-string " *"
+  "*Marker for permanent files in menu \"File >> Open...recently changed\".
+A file can set as permanent with prefix argument 3 for a command in
+`session-kill-buffer-commands'.  It can be set as non-permanent with
+prefix argument -1."
+  :group 'session-miscellaneous
+  :type 'string)
+
+;; TODO: not quite sure whehter this is needed anymore - and if whether
+;; it is the best way to exclude certain files.  Other options are:
+;; based on directory, file name, mode, calling command
+(defcustom session-set-file-name-exclude-regexp
+  "[/\\]\\.overview\\|[/\\]\\.session\\|News[/\\]"
+  "*Regexp matching file names not to be stored in `file-name-history'.
+This is used by `session-set-file-name-history'.  Value nil means, do
+not exclude any file."
+  :group 'session-miscellaneous
+  :type '(choice (const nil) regexp))
+
+(defvar session-menu-accelerator-support
+  (and (featurep 'menu-accelerator-support)
+       (fboundp 'submenu-generate-accelerator-spec)
+       'submenu-generate-accelerator-spec)
+  "Function to generate menu accelerators, or nil if not supported.")
+
+;; calling `abbrev-file-name' on remote files opens the connection!
+(defvar session-abbrev-inhibit-function
+;; this will be renamed with the next release (when minimum is
+;; Emacs-22.1, jun 2007 and XEmacs 21.4.12, jan 2003) -> only there we have
+;; `define-obsolete-variable-alias'
+  (cond ((fboundp 'file-remote-p) 'file-remote-p)
+	;;  `file-remote-p' doesn't exist in Emacs < 22.1
+	((fboundp 'efs-ftp-path) 'efs-ftp-path)
+	((fboundp 'ange-ftp-ftp-name) 'ange-ftp-ftp-name)
+	((fboundp 'ange-ftp-ftp-path) 'ange-ftp-ftp-path))
+  "Function used to determine whether to abbreviate file name.
+A file name is not abbreviated if this function returns non-nil when
+called with the file name.")
+
+(defvar session-directory-sep-char    ; directory-sep-char is not set
+  (if (memq system-type '(ms-dos windows-nt)) ?\\ ?\/)
+  "Directory separator character for session menus.")
+
+(defvar session-save-file-coding-system
+  (cond-emacs-xemacs
+   :EMACS 'iso-latin-1-with-esc
+   ;; used `emacs-mule' but this fails with X-Symbol characters...
+   :XEMACS (and (featurep 'mule) 'escape-quoted))
+  "Coding system to use when writing `session-save-file' if non-nil.")
+
+
+;;;===========================================================================
+;;;  User Options and Configuration: save global variables between sessions
+;;;===========================================================================
+
+(defcustom session-globals-max-size 50
+  "*Maximal number of elements in the global variables.
+Global variables are only saved if they are non-empty lists.  This value
+can be shadowed by some element in `session-globals-include'.  If an
+element appears more than once in the list, only the first appearance
+will be stored."
+  :group 'session-globals
+  :type 'integer)
+
+(defcustom session-globals-max-string 1024
+  "*Maximal length of string elements in global variables."
+  :group 'session-globals
+  :type 'integer)
+
+(defcustom session-registers-max-string 1024
+  "*Maximal length of string elements in registers."
+  :group 'session-globals
+  :type 'integer)
+
+(defcustom session-save-file
+  (expand-file-name ".session"
+		    (cond ((boundp 'user-emacs-directory) user-emacs-directory)
+			  ((boundp 'user-init-directory) user-init-directory)
+			  (t "~")))
+  "File to save global variables and registers into.
+It is saved with coding system `session-save-file-coding-system' at the
+end of an Emacs session and loaded at the beginning.  Used for variables
+which are typically changed by editing operations, e.g., history and
+ring variables.  See \\[session-save-session] for details."
+  :group 'session-globals
+  :type 'file)
+
+(defvar session-old-save-file (expand-file-name ".session" "~"))
+
+(defvar session-save-print-spec '(t 2 1024)
+  ;; only for advanced users -> no custom
+  "*TODO")
+
+(defcustom session-save-file-modes 384
+  "Mode bits of session save file, as an integer, or nil.
+After writing `session-save-file', set mode bits of that file to this
+value if it is non-nil."
+  :group 'session-globals
+  :type '(choice (const :tag "Don't change" nil) integer))
+  
+(defvar session-before-save-hook nil
+  "Hook to be run before `session-save-file' is saved.
+The functions are called after the global variables are written,
+directly before the file is actually saved.")
+
+(defvar session-after-load-save-file-hook
+  (cond-emacs-xemacs
+   :EMACS (and (default-boundp 'yank-menu)
+	       (fboundp 'menu-bar-update-yank-menu)
+	       '(session-refresh-yank-menu)))
+  "Hook to be run after `session-save-file' has been loaded.
+The functions are called when the file has been successfully loaded.")
+
+(defcustom session-globals-regexp "-\\(ring\\|history\\)\\'"
+  "Regexp matching global variables to be saved between sessions.
+Variables in `session-globals-exclude' are not saved, but variables in
+`session-globals-include' are always saved."
+  :group 'session-globals
+  :type 'regexp)
+
+(defcustom session-globals-exclude
+  '(load-history
+    register-alist vc-comment-ring flyspell-auto-correct-ring org-mark-ring
+    planner-browser-file-display-rule-ring)
+  "Global variables not to be saved between sessions.
+It affects `session-globals-regexp' and `session-globals-include'."
+  :group 'session-globals
+  :type '(repeat variable))
+
+(defcustom session-globals-include '((kill-ring 10)
+				     (session-file-alist 100 t)
+				     (file-name-history 200)
+				     search-ring regexp-search-ring)
+  "Global variables to be saved between sessions.
+Each element has one of the following forms:
+  NAME,
+  (NAME MAX-SIZE), or
+  (NAME MAX-SIZE ASSOC-P).
+where NAME is the symbol name of the variable, whose value must be a
+non-empty list and string elements in this list must be smaller than
+`session-globals-max-string'.  MAX-SIZE (default is
+`session-globals-max-size') is the maximal number of elements to be
+saved for this symbol where only the first of equal elements are saved,
+and ASSOC-P (default is nil) non-nil means that the variable is an alist
+where the equality of elements is checked on the `car'.
+
+If MAX-SIZE or ASSOC-P is non-nil, it can be useful to include a
+variable in this list even if it matches `session-globals-regexp'.
+`session-globals-exclude' has no effect on these variables.
+
+Do not use this variable to customize your Emacs.  Package custom is the
+appropriate choice for this!"
+  :group 'session-globals
+  :type '(repeat (choice (variable :tag "List var with standard max size")
+			 (list variable
+			       (integer :tag "Max size")
+			       (boolean :tag "Alist")))))
+
+
+;;;===========================================================================
+;;;  Configuration: registers and local variables
+;;;===========================================================================
+
+(defcustom session-registers '((?0 . ?9) ?- ?= ?\\ ?` region (?a . ?z))
+  "*Registers to be saved in `session-save-file'.
+Valid elements in this list are:
+  CHAR or (FROM . TO) or `file' or `region' or t.
+CHAR is a register to save, (FROM . TO) represents a list of registers
+from FROM to TO.  `file' means, only save the following registers in
+this list if they contain file or file-query references.  `region'
+means, only save registers if they contain a region which has less then
+`session-registers-max-string' characters.  t means, allow both content
+types.  Processing of this list starts with type `file'.
+
+Before saving the session files, markers in registers are turned into
+file references, see variable `session-register-swap-out'."
+  :group 'session-globals
+  :type '(repeat (choice (const :tag "File registers:" file)
+			 (const :tag "String registers:" region)
+			 (const :tag "Any register type:" t)
+			 (character :tag "Register")
+			 (cons :tag "Registers"
+			       (character :tag "From")
+			       (character :tag "To")))))
+
+(defcustom session-locals-include '(overwrite-mode)
+  "Local variables to be stored for specific buffers.
+See also `session-locals-predicate'.
+
+Do not add variables to this list which are more appropriate for local
+variables in files, i.e., variables which are related to the contents of
+the file, e.g. `major-mode'!"
+  :group 'session-places
+  :type '(repeat variable))
+
+(defcustom session-locals-predicate 'local-variable-p
+  "Function which must return non-nil for a local variable to be stored.
+This function is called on all variables in `session-locals-include'
+with the variable as the first and the current buffer as the second
+argument.  Good values are nil (do not store any variable),
+`local-variable-p' for local variables, `local-variable-if-set-p' for
+variables which become local when set, and t (store all variables in
+`session-locals-include')."
+  :group 'session-places
+  :type '(choice (const :tag "none" nil)
+		 (const :tag "All" t)
+		 (function-item local-variable-p)
+		 (function-item local-variable-if-set-p)
+		 (function :tag "Other function")))
+
+(defvar session-register-swap-out (if (fboundp 'register-swap-out)
+				      'register-swap-out
+				    'session-register-swap-out)
+  "Function processing markers in registers when a buffer is killed.
+If non-nil, this function is added to `kill-buffer-hook'.  Good values
+are `register-swap-out' and the function `session-register-swap-out'.")
+
+
+;;;===========================================================================
+;;;  User Options and Configuration: buffer check--undo, mode+name
+;;;===========================================================================
+
+(defcustom session-jump-undo-threshold 240
+  "*Number of character positions the undo position must be different.
+Without prefix arg, `session-jump-to-last-change' jumps successively to
+change positions which differ by at least `session-jump-undo-threshold'
+characters compared to the current position and previously visited
+change positions, see `session-jump-undo-remember'."
+  :group 'session-places
+  :type 'integer)
+
+(defcustom session-jump-undo-remember 2
+  "*Number of previously visited change positions checked additionally.
+See `session-jump-undo-threshold' and `session-jump-to-last-change'."
+  :group 'session-places
+  :type 'integer)
+
+;; Problem if homedir is a symlink (/bar/home -> /net/bar.home) & tmp-mounted
+;;   (file-truename "~/foo") => "/tmp_mnt/net/bar.home/foo"
+;;   (abbreviate-file-name "/tmp_mnt/net/bar.home/foo") => "/net/bar.home/foo"
+;; I.e., there is a bug in `abbreviate-file-name' on both Emacs and XEmacs
+;; (with 2nd arg t).  Workaround: use the following in your ~/.emacs:
+
+;;(unless (string= (abbreviate-file-name (file-truename "~") t) "~") ; XEmacs
+;;  (setq abbreviated-home-dir
+;;	(let ((abbreviated-home-dir "$foo"))
+;;	  (concat "\\`\\(?:"
+;;		  (regexp-quote (abbreviate-file-name (expand-file-name "~")))
+;;		  "\\|"
+;;		  (regexp-quote (abbreviate-file-name (file-truename "~")))
+;;		  "\\)\\(/\\|\\'\\)"))))
+
+(defconst session-use-truenames-default
+  (cond-emacs-xemacs
+   :EMACS  (string= (abbreviate-file-name (file-truename "~")) "~")
+   :XEMACS (and (string= (abbreviate-file-name (file-truename "~") t) "~")
+		(if (eq system-type 'windows-nt)
+		    'session-xemacs-buffer-local-mswindows-file-p
+		  t))))
+
+(defcustom session-use-truenames session-use-truenames-default
+  "*Whether to use the canonical file names when saving/restoring places.
+If a function, it is called with no argument and returns whether to use
+the canonical names of files.  If non-nil, store and check file names
+returned by `file-truename'."
+  :group 'session-places
+  :type '(choice (const :tag "No" nil)
+		 (const :tag "Yes" t)
+		 (function-item :tag "If not starting with \\\\"
+				session-xemacs-buffer-local-mswindows-file-p)
+		 (function :tag "Other function")))
+
+(defcustom session-auto-store t
+  "*Determines whether a buffer to be killed passes the mode/name check.
+This boolean is used by `session-default-buffer-check-p', see
+`session-buffer-check-function'.
+
+A buffer passes the mode/name check, if it passes the mode check, see
+below, and its file name is not matched by
+`session-name-disable-regexp', or if fails the mode check and its file
+name is matched by `session-name-enable-regexp'.
+
+A buffer passes the mode check, if this variable is non-nil and its
+major mode is not a member of `session-mode-disable-list', or if this
+variable is nil and its major mode is a member of
+`session-mode-enable-list'."
+  :group 'session-places
+  :type 'boolean)
+
+(defcustom session-undo-check 1
+  "*Determines how a buffer to be killed passes the undo check.
+Its value is MIN or (MIN . LAST) where MIN is a number.  Used by
+`session-default-buffer-check-p', see `session-buffer-check-function'.
+
+To pass the undo check
+ * the length of `buffer-undo-list', assumed to be -1 if no undo
+   information is recorded, must be higher or equal to MIN,
+ * the first form is used or LAST is nil: no further requirement
+ * LAST is `and': additionally, `session-last-change' must be non-nil,
+   i.e., the buffer has been changed previously,
+ * LAST is `or': alternatively, `session-last-change' is non-nil."
+  :group 'session-places
+  :type '(choice (integer :tag "Min no of Changes")
+		 (cons (integer :tag "Min no of Changes")
+		       (choice :tag "Previous and New Changes"
+			       (const :tag "Only consider New Changes" nil)
+			       (const :tag "AND previously changed" and)
+			       (const :tag "OR previously changed" or)))))
+
+(defcustom session-kill-buffer-commands '(kill-this-buffer)
+  "*Commands which kill a buffer.
+If a prefix argument was provided to any of these commands, it will
+influence the decision whether to store places for the buffer, see
+`session-store-buffer-places'.  Using commands which use the minibuffer
+for input, is useless."
+  :group 'session-places
+  :type '(repeat (function :tag "Command")))
+
+(defcustom session-buffer-check-function 'session-default-buffer-check-p
+  "Function which return non-nil if buffer places should be stored.
+Used by `session-store-buffer-places'.  This function is called with the
+buffer to check as argument.  You can also assume that the current
+buffer is the buffer to check.
+
+The default value `session-default-buffer-check-p' returns non-nil, if
+the buffer
+ * visits an existing readable file,
+ * passes the mode/name check, see `session-auto-store', and
+ * passes the undo check, see `session-undo-check', its default value 1
+   means: the buffer must have been changed during the session."
+  :group 'session-globals
+  :type '(choice (function-item :tag "Default check"
+				session-default-buffer-check-p)
+		 (function :tag "Other function")))
+
+(defcustom session-mode-disable-list
+  '(vm-mode gnus-score-mode message-mode tar-mode)
+  "*Major modes of buffers for which no places are stored.
+See `session-buffer-check-function'."
+  :group 'session-globals
+  :type '(repeat (function :tag "Major mode")))
+
+(defcustom session-mode-enable-list nil
+  "*Major modes of buffers for which places are stored.
+See `session-buffer-check-function'."
+  :group 'session-globals
+  :type '(repeat (function :tag "Major mode")))
+
+(defcustom session-name-disable-regexp
+  (concat "\\`" (regexp-quote
+		 (if (fboundp 'temp-directory) (temp-directory) "/tmp")))
+  "*File names of buffers for which no places are stored.
+See `session-buffer-check-function'."
+  :group 'session-places
+  :type '(choice (const nil) regexp))
+
+(defcustom session-name-enable-regexp nil
+  "*File names of buffers for which places are stored.
+See `session-buffer-check-function'."
+  :group 'session-places
+  :type '(choice (const nil) regexp))
+
+
+
+
+;;;;##########################################################################
+;;;;  Store buffer places and local variables, change register contents
+;;;;##########################################################################
+
+
+(defvar session-last-change nil
+  "Position of last change in current buffer.
+This variable is set by `session-find-file-hook' if the buffer was
+changed in a previous session.  It can also be set by providing an
+prefix argument to `session-jump-to-last-change'.")
+(make-variable-buffer-local 'session-last-change)
+
+(defvar session-file-alist nil
+  "Alist for places and local variables for some files.
+It has the form
+  (NAME POINT MARK POINT-MIN POINT-MAX PERMANENT LAST-CHANGE
+   (SYMBOL . VAR) ...)
+
+NAME is the file name, POINT is the point position, MARK is the mark
+position, POINT-MIN and POINT-MAX determine the narrow part if non-nil,
+PERMANENT is the permanent marker (see `session-buffer-check-function'),
+LAST-CHANGE is the position of the last change in the previous session
+or was explicitly set with prefix argument 0 for command
+\\[session-jump-to-last-change].  Optional pairs (SYMBOL . VAR) are
+local variables with their values.")
+
+(defvar session-jump-to-last-change-counter 0
+  "Number of repeated invocations of `session-jump-to-last-change'.")
+
+(defvar session-jump-to-last-change-recent nil
+  "Current position and previously visited change positions.")
+
+
+;;;===========================================================================
+;;;  Position of last change
+;;;===========================================================================
+
+(defun session-undo-position (num pos1 pos2)
+  "Return a previous undo-position or set it.
+If argument NUM is nil, set `session-last-change' to the recomputed
+position given by argument POS1 and return POS1 normalized.
+
+Otherwise, return a previous undo-position or nil, if no such position
+can be found.  If `session-jump-to-last-change-counter' is nil, the
+position found is the stored last-change position.
+
+If POS1 and POS2 are nil, NUM is the number of undo-boundaries to skip.
+The position returned is the last change inside the corresponding undo
+step.
+
+Otherwise, NUM is the number of undo entries to skip.  The position
+returned is the last change after these entries outside the range from
+POS1 to POS2.  Increment `session-jump-to-last-change-counter' by the
+number of entries skipped additionally."
+  (let ((undo-list (and (consp buffer-undo-list) buffer-undo-list))
+	elem      ; element in undo-list, t = not of interest
+	back-list ; used position must be recomputed due to processed elems
+	len       ; length of deletion/insertion
+	pos)      ; interesting position in undo-list
+    (while (and undo-list (null (car undo-list)))
+      (pop undo-list))			; ignore undo-boundaries at beg
+    (while undo-list
+      ;; inspect element in undo-list ----------------------------------------
+      (setq elem (pop undo-list))
+      (cond ((atom elem)		; marker position
+	     (when (or elem pos1) ; undo-boundary is of interest if POS1=nil
+	       (if (integerp elem)
+		   (setq pos elem	; use point position in undo-list
+			 back-list (cons nil back-list))
+		 (setq elem t))))	; ignore uninteresting elem
+	    ((stringp (car elem))	; deletion: (TEXT . POSITION)
+	     (setq pos (abs (cdr elem))
+		   len (length (car elem)))
+	     (push (list* pos (+ pos len) (- len)) back-list)
+	     (when pos1			; adopt POS{1,2} if after deletion
+	       (if (>  pos1 pos) (incf pos1 len))
+	       (if (>= pos2 pos) (incf pos2 len))))
+	    ((integerp (car elem))	; insertion: (START . END)
+	     (setq pos (car elem)
+		   len (- (cdr elem) pos))
+	     (push (list* pos pos len) back-list)
+	     (when pos1			; adopt POS{1,2} if after/in insertion
+	       (if (> pos1 pos)
+		   (setq pos1 (if (> pos1 (cdr elem)) (- pos1 len) pos)))
+	       (if (> pos2 pos)
+		   (setq pos2 (if (> pos2 (cdr elem)) (- pos2 len) pos))))
+	     (setq pos (cdr elem)))	; point more likely at end of insertion
+	    (t
+	     (setq elem t)))
+      ;; evaluation element inspection ---------------------------------------
+      (cond ((null num))		; set POS1 as `session-last-change'
+	    ((null pos1)		; looking for undo-boundaries
+	     (when (if elem
+		       (and (zerop num) pos)
+		     (<= (decf num) 0))
+	       (setq undo-list nil)))
+	    ((eq elem t)		; uninteresting element
+	     (setq pos nil))
+	    ((> num 0)			; interesting, but not the NUM's one
+	     (decf num)
+	     (setq pos nil))
+	    ((and (<= pos1 pos) (<= pos pos2)) ; inside start region
+	     (incf session-jump-to-last-change-counter)
+	     (setq pos nil))
+	    (t
+	     (setq undo-list nil))))
+    ;; finalize: evaluate result and process back-list -----------------------
+    (cond ((null num)			; set POS1 as `session-last-change'
+	   (setq session-last-change pos1
+		 pos session-last-change))
+	  ((or (null pos) (> num 0))	; no position found in undo-list
+	   (setq session-jump-to-last-change-counter nil)
+	   (setq pos session-last-change))
+	  (t				; pos in undo-list
+	   (if session-jump-to-last-change-counter
+	       (incf session-jump-to-last-change-counter))
+	   (setq back-list (cdr back-list))))
+    (when pos
+      (while back-list
+	(setq elem (pop back-list))
+	(cond ((null elem))		; integer position in undo-list
+	      ((> pos (cadr elem))	; position after affected region
+	       (incf pos (cddr elem)))	; increment/decrement position
+	      ((> pos (car elem))	; position in affected region
+	       (setq pos (car elem)))))	; set position to region begin
+      pos)))
+
+;;;###autoload
+(defun session-jump-to-last-change (&optional arg)
+  "Jump to the position of the last change.
+Without prefix arg, jump successively to previous change positions which
+differ by at least `session-jump-undo-threshold' characters by repeated
+invocation of this command.  With prefix argument 0, jump to end of last
+change.  With numeric prefix argument, jump to start of first change in
+the ARG's undo block in the `buffer-undo-list'.
+
+With non-numeric prefix argument (\\[universal-argument] only), set
+point as oldest change position.  It might change slightly if you jump
+to it due to intermediate insert/delete elements in the
+`buffer-undo-list'."
+  ;; note: for compatibility reasons (pre v2.2), we use abs(ARG)
+  (interactive "P")
+  (if (consp arg)
+      (let ((pos (session-undo-position nil (point) (point)))
+	    (undo-list (and (consp buffer-undo-list) buffer-undo-list)))
+	(setq arg 1)
+	(while (and undo-list (null (car undo-list))) (pop undo-list))
+	(while undo-list (or (pop undo-list) (incf arg)))
+	(message "Store %d as special last-change position (%s %d %s)"
+		 pos
+		 (substitute-command-keys "\\[universal-argument]")
+		 arg
+		 (substitute-command-keys "\\[session-jump-to-last-change]")))
+    ;; set and restrict previously visited undo positions --------------------
+    (push (point) session-jump-to-last-change-recent)
+    (if (and (null arg) (eq last-command 'session-jump-to-last-change-seq))
+	(let ((recent (nthcdr session-jump-undo-remember
+			      session-jump-to-last-change-recent)))
+	  (if recent (setcdr recent nil)))
+      (setcdr session-jump-to-last-change-recent nil) ; only point
+      (setq session-jump-to-last-change-counter 0))
+    (let (pos)
+      (if arg
+	  (setq pos (session-undo-position (abs (prefix-numeric-value arg))
+					   nil nil))
+	;; compute position, compare it with positions in
+	;; `session-jump-to-last-change-recent'
+	(let ((recent session-jump-to-last-change-recent) old pos1 pos2)
+	  (setq pos (point))
+	  (while recent			; at least point is there
+	    (setq old (pop recent))
+	    (setq pos1 (- pos session-jump-undo-threshold)
+		  pos2 (+ pos session-jump-undo-threshold))
+	    (when (and (<= pos1 old) (<= old pos2))
+	      (setq pos (session-undo-position
+			 session-jump-to-last-change-counter pos1 pos2))
+	      (setq recent (and pos
+				session-jump-to-last-change-counter
+				session-jump-to-last-change-recent))))))
+      (cond ((null pos)
+	     (message (if (or arg (atom buffer-undo-list))
+			  "Do not know position of last change"
+			"Do not know position of last distant change")))
+	    ((< pos (point-min))
+	     (goto-char (point-min))
+	     (message "Change position outside visible region"))
+	    ((> pos (point-max))
+	     (goto-char (point-max))
+	     (message "Change position outside visible region"))
+	    (t
+	     (goto-char pos)
+	     (cond ((null session-jump-to-last-change-counter)
+		    (message "Jumped to stored last-change position"))
+		   ((null arg)
+		    (setq this-command 'session-jump-to-last-change-seq))))))))
+
+
+;;;===========================================================================
+;;;  Yank menu (Emacs: refresh existing menu, XEmacs: do our own)
+;;;===========================================================================
+
+;; this function should be defined in menu-bar.el...
+(defunx session-refresh-yank-menu ()
+  :xemacs-only ignore
+  "Refresh `yank-menu' according to `kill-ring'."
+  (when (and (default-boundp 'yank-menu)
+	     (fboundp 'menu-bar-update-yank-menu))
+    (let ((killed (reverse (default-value 'kill-ring))))
+      (while killed
+	(menu-bar-update-yank-menu (pop killed) nil)))))
+
+(defun session-yank (arg)
+  "Reinsert the last stretch of killed text, like \\[yank].
+Calls `yank' with argument ARG and with `interprogram-paste-function'
+bound to nil."
+  (interactive "*p")
+  (let ((interprogram-paste-function nil)) ;#dynamic
+    (yank arg)))
+
+(defun session-popup-yank-menu (event)
+  ;; checkdoc-params: (event)
+  "Pop up a menu for inserting items in `kill-ring'."
+  (interactive "e")
+  (when kill-ring
+    (setq this-command last-command)
+    (popup-menu '("Select and Paste"
+		  :filter session-yank-menu-filter))))
+
+(defun session-yank-menu-filter (menu-items)
+  ;; checkdoc-params: (menu-items)
+  "Return a menu for inserting items in `kill-ring'."
+  (let ((menu nil)
+	(ring nil)
+	(max session-menu-max-size)
+	(len (length kill-ring))
+	(half-str-len (/ (- session-edit-menu-max-string 4) 2))
+	(i 0)
+	(active (not buffer-read-only))
+	elem
+	(interprogram-paste-function nil)) ;#dynamic
+    ;; Traversing (append kill-ring-yank-pointer kill-ring) instead indexing
+    ;; (current-kill INDEX) would be probably more efficient, but would be a
+    ;; very low-level hack
+    (while (and (< i len) (> max 0))
+      (setq elem (current-kill i t)
+	    i (1+ i))
+      (unless (or (assoc elem ring) (string-match "\\`[ \t\n]*\\'" elem))
+	(push (cons elem i) ring)
+	(setq max (1- max))))
+    (while ring
+      (setq elem (car ring)
+	    ring (cdr ring))
+      (push (session-yank-string (car elem) half-str-len
+				 (list 'session-yank (cdr elem))
+				 active)
+	    menu))
+    (session-menu-maybe-accelerator menu-items menu)))
+
+(defun session-yank-string (string half-len-str callback active)
+  ;; checkdoc-order: nil
+  "Return menu item STRING with callback CALLBACK.
+If ACTIVE is non-nil, the item is active.  HALF-LEN-STR is the length of
+the two parts of a abbreviated menu item name."
+  (let ((beg (or (and session-compact-yank-gap-regexp
+		      (string-match "\\`[ \t\n]+" string)
+		      (match-end 0))
+		 0))
+	(end (or (and session-compact-yank-gap-regexp
+		      (string-match "[ \t\n]+\\'" string))
+		 (length string))))
+    (vector (if (> (- end beg) session-edit-menu-max-string)
+		(let ((gap (and session-compact-yank-gap-regexp
+				(string-match session-compact-yank-gap-regexp
+					      string (- end half-len-str))
+				(match-end 0))))
+		  (if (and gap (< gap (- end 3)))
+		      (setq half-len-str (- (+ half-len-str half-len-str gap)
+					    end))
+		    (setq gap (- end half-len-str)))
+		  (concat (session-subst-char-in-string
+			   ?\t ?\ (substring string beg (+ beg half-len-str)) t)
+			  " ... "
+			  (session-subst-char-in-string
+			   ?\t ?\ (substring string gap end) t)))
+	      (session-subst-char-in-string
+	       ?\t ?\  (substring string beg end) t))
+	    callback
+	    active)))
+
+;; from EMACS-20.4/lisp/subr.el:
+(defunx session-subst-char-in-string (fromchar tochar string &optional inplace)
+  :try subst-char-in-string
+  "Replace FROMCHAR with TOCHAR in STRING each time it occurs.
+Unless optional argument INPLACE is non-nil, return a new string."
+  (let ((i (length string))
+	(newstr (if inplace string (copy-sequence string))))
+    (while (> i 0)
+      (setq i (1- i))
+      (if (eq (aref newstr i) fromchar)
+	  (aset newstr i tochar)))
+    newstr))
+
+
+;;;===========================================================================
+;;;  Menu filters (XEmacs only)
+;;;===========================================================================
+
+(defun session-file-opened-recompute ()
+  (interactive)
+  (session-file-changed-recompute t))
+
+(defun session-file-changed-recompute (&optional for-opened)
+  (interactive)
+  (let ((session-use-package t))	;#dynamic
+    (save-excursion
+      (dolist (buffer (nreverse (buffer-list)))
+	(set-buffer buffer)
+	(when buffer-file-name
+	  (condition-case nil	; potential errors with remote files
+	      (if for-opened
+		  (session-set-file-name-history)
+		(session-store-buffer-places 1))
+	    (error nil)))))))
+
+(defun session-file-opened-menu-filter (menu-items)
+  ;; checkdoc-params: (menu-items)
+  "This is the menu filter for \"File >> Open...recently visited\".
+See `session-file-changed-menu-filter'."
+  (session-file-changed-menu-filter menu-items file-name-history))
+
+(defun session-file-changed-menu-filter (menu-items &optional files find-fn)
+  ;; checkdoc-params: (menu-items)
+  "This is the menu filter for \"File >> Open...recently changed\".
+It dynamically creates a list of files to use as the contents of the
+menu.  The files are taken from FILES or `session-file-alist'.  It
+doesn't show the same name twice and shows `session-menu-max-size' names
+at most.  FIND-FN or \\[find-file] is the function to use when selecting
+a file in the menu."
+  (or files (setq files session-file-alist))
+  (or find-fn (setq find-fn 'session-find-file))
+  (let ((excl nil)
+	(menu nil)
+	(i session-menu-max-size)
+	(max-string (max (cond ((natnump session-file-menu-max-string)
+				session-file-menu-max-string)
+			       ((integerp session-file-menu-max-string)
+				(- 0 session-file-menu-max-string
+				   (length (buffer-name))))
+			       ((consp session-file-menu-max-string)
+				(- (car session-file-menu-max-string)
+				   (max (- (length (buffer-name))
+					   (cdr session-file-menu-max-string))
+					0)))
+			       (t 50))
+			 16)))
+    (while (and files (> i 0))
+      (let ((name (pop files)) desc)
+	(when (consp name)
+	  (setq desc name
+		name (car name)))
+	(setq name (session-abbrev-file-name (directory-file-name name)))
+	(unless (member name excl)
+	  (setq i (1- i))
+	  (push name excl)
+	  (push (vector (or (session-file-prune-name name max-string) name)
+			(list find-fn name)
+			:keys (concat (and (sixth desc) "p")
+				      (let ((buf (get-file-buffer name))) 
+					(when buf
+					  (with-current-buffer buf
+					    (if (consp buffer-undo-list)
+						(if (buffer-modified-p)
+						    "c" "s")
+					      (if buffer-read-only
+						  "r" "v")))))))
+		menu))))
+    (session-menu-maybe-accelerator menu-items (nreverse menu))))
+
+(defun session-file-prune-name (elem max-string)
+  (when (> (length elem) max-string)
+    (let* ((sep-string (char-to-string session-directory-sep-char))
+	   (components (split-string elem (regexp-quote sep-string))))
+      (or (cdr components)	; successful split
+	  (eq session-directory-sep-char ?\/) ; already Unix separator
+	  (setq sep-string "/"
+		components (split-string elem (regexp-quote sep-string))))
+      (let* ((prefix (if (< (length (car components)) 3) ; e.g. "~" or "C:"
+			 (concat (pop components) sep-string
+				 (pop components))
+		       (pop components)))
+	     (len (+ (length prefix) 7)) ; "/ ... /"
+	     postfix)
+	(when (cdr components)		; more than one remaining dir component
+	  (setq components (nreverse components))
+	  (incf len (length (car components)))
+	  (push (pop components) postfix) ; always use last one
+	  (while (<= (incf len (1+ (length (car components)))) max-string)
+	    (push (pop components) postfix))
+	  (concat prefix sep-string " ... " sep-string
+		  (mapconcat 'identity postfix sep-string)))))))
+
+(defun session-menu-maybe-accelerator (menu-items menu)
+  "Return menu consisting of items in MENU-ITEMS and MENU.
+MENU-ITEMS have the usual format of elements in a menu, except that the
+name always starts with a accelerator specification \"%_. \".  Also, a
+:keys specification will be evaluated if :keys is the first keyword.
+
+The items in MENU will be modified to add accelerator specifications if
+`session-menu-accelerator-support' is non-nil."
+  (append menu-items
+	  (if session-menu-accelerator-support
+	      (funcall session-menu-accelerator-support menu)
+	    menu)))
+
+(defun session-change-menu-item (item)  ;; TODO: delete
+  "Change ITEM according to `session-menu-maybe-accelerator'."
+  (if (vectorp item)
+      (let ((keys (and (eq (aref item 2) :keys)
+		       (not (stringp (aref item 3))))))
+	(if (if session-menu-accelerator-support keys t)
+	    (prog1 (setq item (copy-sequence item))
+	      (if keys
+		  (aset item 3 (eval (aref item 3))))
+	      (or session-menu-accelerator-support
+		  (aset item 0 (substring (aref item 0) 4))))
+	  item))
+    item))
+
+(defun session-abbrev-file-name (name)
+  "Return a version of NAME shortened using `directory-abbrev-alist'.
+This function does not consider remote file names (see
+`session-abbrev-inhibit-function') and substitutes \"~\" for the user's
+home directory."
+  (if (and session-abbrev-inhibit-function
+	   (or (not (fboundp session-abbrev-inhibit-function))
+	       (funcall session-abbrev-inhibit-function name)))
+      name
+    (cond-emacs-xemacs (abbreviate-file-name name :XEMACS t))))
+
+
+;;;===========================================================================
+;;;  Functions in hooks
+;;;===========================================================================
+
+(defun session-find-file (filename)
+  ;; also sets history when just switching to existing buffer
+  (interactive "FFind file: ")
+  (find-file filename)
+  (let ((session-use-package t))	;#dynamic
+    (session-set-file-name-history)))
+
+(defun session-set-file-name-history ()
+  "Add file-name of current buffer to `file-name-history'.
+Don't add the file name if it matches
+`session-set-file-name-exclude-regexp', or if it is already at the front
+of `file-name-history'.  This function is useful in `find-file-hooks'."
+  (and session-use-package
+       buffer-file-name
+       (not (string= (car file-name-history) buffer-file-name))
+       (not (string= (car file-name-history) buffer-file-truename))
+;;       (file-exists-p buffer-file-name) (file-readable-p buffer-file-name)
+       (let ((name (session-abbrev-file-name buffer-file-name)))
+	 (unless (and session-set-file-name-exclude-regexp
+		      (string-match session-set-file-name-exclude-regexp name))
+	   (push name file-name-history)))))
+
+(defun session-find-file-hook ()
+  "Function in `find-file-hooks'.  See `session-file-alist'."
+  (unless (or (eq this-command 'session-disable)
+	      (null session-use-package))
+    (let* ((ass (assoc (session-buffer-file-name) session-file-alist))
+	   (point (second ass))
+	   (mark (third ass))
+	   (min (fourth ass))
+	   (max (fifth ass))
+	   (alist (nthcdr 7 ass)))
+      (condition-case nil
+	  (while alist
+	    (if (local-variable-if-set-p (caar alist) (current-buffer))
+		(set (caar alist) (cdar alist)))
+	    (setq alist (cdr alist)))
+	(error nil))
+      (setq session-last-change (seventh ass))
+      (and mark
+	   (<= (point-min) mark) (<= mark (point-max))
+	   ;; I had `set-mark' but this function activates mark in Emacs, but
+	   ;; not in XEmacs.  `push-mark' is also OK and doesn't activate in
+	   ;; both Emacsen which is better if we use `pending-delete-mode'.
+	   (push-mark mark t))
+      (and min max
+	   (<= (point-min) min) (<= max (point-max))
+	   (narrow-to-region min max))
+      (and point
+	   (<= (point-min) point) (<= point (point-max))
+	   (goto-char point)))))
+
+(defun session-kill-buffer-hook ()
+  "Function in `kill-buffer-hook'.
+See `session-file-alist' and `session-registers'."
+  (if (and session-use-package buffer-file-name)
+      (let ((arg (if (memq this-command session-kill-buffer-commands)
+		     (prefix-numeric-value current-prefix-arg)
+		   1)))
+	(condition-case nil
+	    (if (> arg -2)
+		(session-store-buffer-places arg)
+	      (setq file-name-history
+		    (delete buffer-file-truename
+			    (delete buffer-file-name file-name-history)))
+;;;	      (setq session-file-alist
+;;;		    (delete* (session-buffer-file-name) session-file-alist
+;;;			     :key 'car :test 'string=)))  ; Emacs CL policy...
+	      (let ((fname (session-buffer-file-name))
+		    (alist (cons nil session-file-alist)))
+		(while (cdr alist)
+		  (if (string= (cadr alist) fname)
+		      (setcdr alist (cddr alist))
+		    (setq alist (cdr alist))))
+		(setq session-file-alist (cdr alist))))
+	  (error nil)))))
+
+
+;;;===========================================================================
+;;;  Change register contents from marker to file
+;;;===========================================================================
+
+(defun session-register-swap-out ()
+  "Turn markers in registers into file references when a buffer is killed.
+See variable `session-register-swap-out'."
+  (and buffer-file-name
+       (let ((tail register-alist))
+	 (while tail
+	   (and (markerp (cdr (car tail)))
+		(eq (marker-buffer (cdr (car tail))) (current-buffer))
+		(setcdr (car tail)
+			(cons 'file buffer-file-name)))
+	   (setq tail (cdr tail))))))
+
+
+
+;;;;##########################################################################
+;;;;  Save global variables, add functions to hooks
+;;;;##########################################################################
+
+
+(defvar session-successful-p nil
+  "Whether the file `session-save-file' has been loaded successfully.")
+
+
+;;;===========================================================================
+;;;  The buffer file name
+;;;===========================================================================
+
+(defun session-xemacs-buffer-local-mswindows-file-p ()
+  "Return t if the current buffer visits a local file on MS-Windows.
+Also returns t if the current buffer does not visit a file.  Return nil
+of the current buffer visits a file starting with \"\\\\\".  Workaround
+for XEmacs bug in `file-truename' for file names starting with
+\"\\\\\"."
+  (or (< (length buffer-file-name) 2)
+      (not (string= (substring buffer-file-name 0 2) "\\\\"))))
+
+(defun session-buffer-file-name ()
+  "Return the buffer file name according to `session-use-truenames'."
+  (if (if (functionp session-use-truenames)
+	  (funcall session-use-truenames)
+	session-use-truenames)
+      buffer-file-truename
+    buffer-file-name))
+
+
+;;;===========================================================================
+;;;  Store places and local variables for buffer to be killed
+;;;===========================================================================
+
+(defun session-toggle-permanent-flag (arg &optional check)
+  "Toggle the permanent flag of the current buffer.
+With ARG, set permanent flag if and only if ARG is positive.  If the
+permanent flag is set, the places are stored as well.  If CHECK is
+non-nil, just return the status of the permanent flag: either nil if it
+is unset or `session-menu-permanent-string' if it is set."
+  (interactive "P")
+  (if buffer-file-name
+      (let ((permanent (if arg
+			   (> (prefix-numeric-value arg) 0)
+			 (not (nth 5 (assoc (session-buffer-file-name)
+					    session-file-alist))))))
+	(if check
+	    (if permanent nil session-menu-permanent-string)
+	  (session-store-buffer-places (if permanent 3 -1))
+	  (message (if permanent
+		       "Permanent flag is set and places are stored"
+		     "Permanent flag has been unset"))))
+    (if check nil (error "Buffer is not visiting a file"))))
+
+(defun session-store-buffer-places (arg)
+  "Store places and local variables in current buffer.
+An entry for the current buffer and its places is added to the front of
+`session-file-alist' if the buffer is visiting a file and if it is
+mentioned in the list below.  ARG is the prefix argument to a command in
+`session-kill-buffer-commands' or 1 for any other command.
+
+ARG=-1: delete PERMANENT flag for buffer,
+ARG=0: do nothing,
+ARG=1: store buffer places, if the PERMANENT flag is set or the buffer
+  passes the function in `session-buffer-check-function',
+ARG=2: always store buffer places,
+ARG=3: set PERMANENT flag and store buffer places.
+
+See also `session-last-change' and `session-locals-include'.
+
+Note that not storing buffer places does not mean deleting an old entry
+for the same file.  It means that there is the danger of the entry
+becoming too old to be saved across session.  By default, only the first
+100 entries of `session-file-alist' are saved, see
+`session-globals-include'."
+  (let ((file-name (session-buffer-file-name)))
+    (when file-name
+      (let ((permanent (nthcdr 5 (assoc file-name session-file-alist))))
+	(and (< arg 0) (car permanent)
+	     (setcar permanent nil))	; reset permanent in existing entry
+	(setq permanent (or (car permanent) (> arg 2)))
+	(if (or (and permanent (> arg 0))
+		(> arg 1)
+		(and (= arg 1)
+		     (funcall session-buffer-check-function (current-buffer))))
+	    (let ((locals session-locals-include)
+		  (store nil))
+	      (while locals
+		(if (if (functionp session-locals-include)
+			(funcall session-locals-predicate
+				 (car locals) (current-buffer))
+		      session-locals-predicate)
+		    (push (cons (car locals)
+				(symbol-value (car locals)))
+			  store))
+		(setq locals (cdr locals)))
+	      (setq store
+		    (nconc (list file-name
+				 (point) (mark t)
+				 (point-min)
+				 (and (<= (point-max) (buffer-size))
+				      (point-max))
+				 permanent
+				 (session-undo-position 0 nil nil))
+			   store))
+	      (if (equal (caar session-file-alist) file-name)
+		  (setcar session-file-alist store)
+		(push store session-file-alist))))))))
+
+(defun session-find-file-not-found-hook ()
+  "Query the user to delete the permanent flag for a non-existent file.
+Always return nil."
+  (when session-use-package
+    (let ((file-name (session-buffer-file-name)))
+      (when file-name
+	(let ((permanent (nthcdr 5 (assoc file-name session-file-alist))))
+	  (and (car permanent)
+	       (y-or-n-p "Delete permanent flag for non-existent file? ")
+	       (setcar permanent nil)))))))
+
+
+;;;===========================================================================
+;;;  Default standard check for buffers to be killed
+;;;===========================================================================
+
+(defun session-default-buffer-check-p (buffer)
+  "Default function for `session-buffer-check-function'.
+Argument BUFFER should be the current buffer."
+  (and
+   ;; undo check -------------------------------------------------------------
+   (or (and (eq (cdr-safe session-undo-check) 'or)
+	    session-last-change)
+       (and (or (not (eq (cdr-safe session-undo-check) 'and))
+		session-last-change)
+	    (>= (if (listp buffer-undo-list) (length buffer-undo-list) -1)
+		(if (consp session-undo-check)
+		    (car session-undo-check)
+		  session-undo-check))))
+   ;; mode and name check ----------------------------------------------------
+   (let ((file (buffer-file-name buffer)))
+     (and (or (and (fboundp session-abbrev-inhibit-function)
+		   (funcall session-abbrev-inhibit-function file))
+	      (and (file-exists-p file) (file-readable-p file)))
+	  (if (if session-auto-store
+		  (not (memq major-mode session-mode-disable-list))
+		(memq major-mode session-mode-enable-list))
+	      (not (and session-name-disable-regexp
+			(string-match session-name-disable-regexp file)))
+	    (and session-name-enable-regexp
+		 (string-match session-name-enable-regexp file)))))))
+
+
+;;;===========================================================================
+;;;  Save session file
+;;;===========================================================================
+
+(defun session-save-session (&optional force)
+  "Save session: file places, *-ring, *-history, registers.
+Save some global variables and registers into file `session-save-file'
+with coding system `session-save-file-coding-system'.  Run functions in
+`session-before-save-hook' before writing the file.
+
+See also `session-globals-regexp', `session-globals-include' and
+`session-registers'.
+
+This command is executed when using \\[save-buffers-kill-emacs] without
+prefix argument 0.  See `kill-emacs-hook'."
+  (interactive "p")
+  (and (or force session-use-package)
+       session-save-file
+       (not (and (eq this-command 'save-buffers-kill-emacs)
+		 (equal current-prefix-arg 0)))
+       (or session-successful-p
+	   (not (file-exists-p session-save-file))
+	   (y-or-n-p "Overwrite old session file (not loaded)? "))
+       (save-excursion
+	 ;; `kill-emacs' doesn't kill the buffers ----------------------------
+	 (dolist (buffer (nreverse (buffer-list)))
+	   (set-buffer buffer)
+	   (when buffer-file-name
+	     (condition-case nil	; potential errors with remote files
+		 (session-store-buffer-places 1)
+	       (error nil))
+	     (if session-register-swap-out
+		 (funcall session-register-swap-out))))
+	 ;; create header of session file ------------------------------------
+	 (set-buffer (get-buffer-create " session "))
+	 (erase-buffer)
+	 (let ((coding-system-for-write	;#dynamic
+		(and session-save-file-coding-system
+		     (condition-case nil
+			 (check-coding-system session-save-file-coding-system)
+		       (error nil)))))
+	   (when coding-system-for-write
+	     (insert (format ";;; -*- coding: %S; -*-\n"
+			     session-save-file-coding-system)))
+	   (insert ";;; Automatically generated on " (current-time-string)
+		   "\n;;; Invoked by " (user-login-name) "@" (system-name)
+		   " using " emacs-version "\n")
+	   ;; save global variables and registers ----------------------------
+	   (let ((s-excl session-globals-exclude))
+	     (dolist (incl (append session-globals-include
+				   (apropos-internal session-globals-regexp
+						     'boundp)))
+	       (let ((symbol (if (consp incl) (car incl) incl)))
+		 (unless (memq symbol s-excl)
+		   (push symbol s-excl)
+		   (when (default-boundp symbol)
+		     (session-save-insert-variable symbol
+						   (default-value symbol)
+						   (cdr-safe incl)))))))
+	   (session-save-registers)
+	   ;; write session file ---------------------------------------------
+	   (run-hooks 'session-before-save-hook)
+	   (condition-case var
+	       (progn
+		 (if (file-exists-p session-save-file)
+		     (delete-file session-save-file))
+		 (make-directory (file-name-directory session-save-file) t)
+		 (write-region (point-min) (point-max) session-save-file)
+		 (if session-save-file-modes
+		     (set-file-modes session-save-file
+				     session-save-file-modes)))
+	     (error			; efs would signal `ftp-error'
+	      (or (y-or-n-p "Could not write session file.  Exit anyway? ")
+		  (cond-emacs-xemacs
+		   (:EMACS signal :XEMACS signal-error :BOTH
+			   (car var) (cdr var))))))
+	   (kill-buffer (current-buffer))))))
+
+(defun session-save-insert-variable (symbol val spec)
+  ;; we don't print at all:
+  ;;  - level-1 recursive lists
+  ;;  - non true-list-p lists
+  ;; we don't print the following elements:
+  ;;  - non-cons for assoc lists
+  ;;  - string which are too long
+  ;;  - non-readable elements (includes level-n recursions)
+  (when (consp val)
+    (let ((print-circle (car session-save-print-spec)) ;#dynamic
+	  (print-level  (cadr session-save-print-spec)) ;#dynamic
+	  (print-length (caddr session-save-print-spec)) ;#dynamic
+	  (len   (or (car spec) session-globals-max-size))
+	  (ass-p (cadr spec))
+	  (slist nil) klist clist)
+      (while (and (consp val) (> len 0))
+	(if (memq val clist)
+	    (setq val t)	; don't print recursive lists
+	  (push val clist)
+	  (let* ((elem (pop val))
+		 (estr (prin1-to-string elem)))
+	    ;; read/load isn't clever: ignore non-readable elements
+	    (unless (cond (ass-p
+			   (or (atom elem)
+			       (member (car elem) klist)
+			       (condition-case nil
+				   (prog1 nil
+				     (read estr)
+				     (push (car elem) klist))
+				 (error t))))
+			  ((member estr slist))
+			  ((stringp elem)
+			   (> (length elem) session-globals-max-string))
+			  ((condition-case nil
+			       (prog1 nil
+				 (read estr))
+			     (error t))))
+	      (push estr slist)
+	      (decf len)))))
+      (when (and slist (null val))	; don't print non-true lists
+	(insert (format "(setq-default %S '(" symbol))
+	(setq slist (nreverse slist))
+	(while slist
+	  (insert (pop slist) (if slist " " "))\n")))))))
+
+(defunx session-next-range-char (char)
+  ;; XEmacs register functions should handle integers as chars better...
+  :emacs-only  1+
+  (int-to-char (1+ char)))
+
+(defun session-save-registers ()
+  "Save registers in `session-registers'."
+  (let ((chars session-registers)
+	(type 'file)
+	register from to)
+    (while chars
+      (if (symbolp (car chars))
+	  (setq type  (car chars)
+		chars (cdr chars))
+	(setq from (car chars)
+	      chars (cdr chars))
+	(if (consp from)
+	    (setq to   (cdr from)
+		  from (car from))
+	  (setq to from))
+	(while (<= from to)
+	  (setq register (get-register from))
+	  (cond ((null register))
+		((and (memq type '(file t))
+		      (consp register)
+		      (memq (car register) '(file file-query)))
+		 (insert (if (eq (car register) 'file)
+			     (format "(set-register %S '(file . %S))\n"
+				     from (cdr register))
+			   (format "(set-register %S '(file-query %S %d))\n"
+				   from (cadr register) (caddr register)))))
+		((and (memq type '(region t))
+		      (stringp register)
+		      (< (length register) session-registers-max-string))
+		 (insert (format "(set-register %S %S)\n" from register))))
+	  (setq from (session-next-range-char from)))))))
+
+
+;;;===========================================================================
+;;;  Minibuffer history completion, see XEmacs' list-mode
+;;;===========================================================================
+
+(defvar session-history-help-string
+  '(concat (if (device-on-window-system-p)
+	       (substitute-command-keys "Click \\\\[list-mode-item-mouse-selected] on a history element to select it.\n") "")
+	   (substitute-command-keys "In this buffer, type RET to select the element near point.\n\n"))
+  "Form the evaluate to get a help string for history elements.")
+
+(defun session-minibuffer-history-help ()
+  "List history of current minibuffer type.
+In Emacs, the *History* buffer talks about \"completions\" instead
+\"history elements\".  In XEmacs before 21.4.9, selecting an entry might
+not work if the minibuffer is non-empty."
+  (interactive)
+  (let ((history (symbol-value minibuffer-history-variable)))
+    (message nil)
+    (if history
+	(with-output-to-temp-buffer "*History*"
+	  (cond-emacs-xemacs
+	   (display-completion-list
+	    (sort history #'string-lessp)
+	    :XEMACS
+	    :help-string session-history-help-string
+	    :completion-string "Elements in the history are:"))
+	  (save-excursion
+	    (set-buffer standard-output)
+	    (setq completion-base-size 0)))
+      (ding)
+      (session-minibuffer-message " [Empty history]"))))
+
+(defunx session-minibuffer-message (string)
+  :emacs-only  minibuffer-message
+  :xemacs-only temp-minibuffer-message)
+
+
+;;;===========================================================================
+;;;  Set hooks, load session file
+;;;===========================================================================
+
+;; easymenu.el is for top-level menus only...  both Emacs and XEmacs could
+;; profit from a better menu interface...
+(defunx session-add-submenu (menu)
+  "Add the menu MENU to the beginning of the File menu in the menubar.
+If the \"File\" menu does not exist, no submenu is added.  See
+`easy-menu-define' for the format of MENU."
+  (and menu
+       :EMACS
+       (>= emacs-major-version 21)
+       (boundp 'menu-bar-files-menu)
+       (let ((keymap (easy-menu-create-menu (car menu) (cdr menu))))
+	 ;; `easy-menu-get-map' doesn't get the right one => use hard-coded
+	 (define-key menu-bar-files-menu (vector (intern (car menu)))
+	   (cons 'menu-item
+		 (cons (car menu)
+		       (if (not (symbolp keymap))
+			   (list keymap)
+			 (cons (symbol-function keymap)
+			       (get keymap 'menu-prop)))))))
+       :XEMACS
+       (featurep 'menubar)
+       (let ((current-menubar default-menubar) ;#dynamic
+	     (first (cadar (find-menu-item default-menubar '("File")))))
+	 (when first
+	   ;; XEmacs-20.4 `add-submenu' does not have 4th arg IN-MENU
+	   (add-submenu '("File") menu
+			;; arg BEFORE cannot be retrieved by any
+			;; menubar function -- great...
+			(cond ((vectorp first) (aref first 0))
+			      ((consp first) (car first))))))))
+
+(defunx session-initialize-keys ()
+  (define-key ctl-x-map [(undo)] 'session-jump-to-last-change)
+  (define-key ctl-x-map [(control ?\/)] 'session-jump-to-last-change)
+  (define-key minibuffer-local-map [(meta ?\?)]
+    'session-minibuffer-history-help)
+  :XEMACS
+  ;; C-down-mouse-3 pops up mode menu under Emacs
+  (define-key global-map [(control button3)] 'session-popup-yank-menu)
+  :EMACS
+  ;; Emacs doesn't seem to have keymap inheritance...
+  (define-key minibuffer-local-completion-map [(meta ?\?)]
+    'session-minibuffer-history-help)
+  (define-key minibuffer-local-must-match-map [(meta ?\?)]
+    'session-minibuffer-history-help)
+  (define-key minibuffer-local-ns-map [(meta ?\?)]
+    'session-minibuffer-history-help))
+
+(defunx session-initialize-menus ()
+  (session-add-submenu '("Open...Recently Visited"
+			 :included file-name-history
+			 :filter session-file-opened-menu-filter
+			 ["Move File Names Of All Buffers To Top"
+			  session-file-opened-recompute]
+			 "---"))
+  (session-add-submenu '("Open...Recently Changed"
+			 ;;:included session-file-alist
+			 :filter session-file-changed-menu-filter
+			 ["Perform Evaluation For All Buffers"
+			  session-file-changed-recompute]
+			 ["Permanently List Current Buffer "
+			  session-toggle-permanent-flag
+			  ;; :keys must be at third position!
+			  ;;:keys (session-toggle-permanent-flag nil t)
+			  :active buffer-file-name
+			  :style toggle
+			  :selected (session-toggle-permanent-flag nil t)]
+			 "---"))
+  :XEMACS
+  (and (featurep 'menubar)
+       (find-menu-item default-menubar '("Edit"))
+       (let ((current-menubar default-menubar))
+	 ;; XEmacs-20.4 `add-submenu' does not have 4th arg IN-MENU
+	 (add-submenu '("Edit")
+		      '("Select and Paste"
+			:included kill-ring
+			:filter session-yank-menu-filter)
+		      (cond ((find-menu-item default-menubar
+					     '("Edit" "Delete"))
+			     "Delete")	; why just BEFORE, not AFTER
+			    ((find-menu-item default-menubar
+					     '("Edit" "Paste"))
+			     "Paste")
+			    ((find-menu-item default-menubar
+					     '("Edit" "Undo"))
+			     "Undo"))))))
+
+(defun session-initialize-do ()
+  "Initialize package session and read previous session file.
+Setup hooks and load `session-save-file', see variable `session-initialize'.  At
+best, this function is called at the end of the Emacs startup, i.e., add
+this function to `after-init-hook'."
+  (when (and session-use-package
+	     (null (get 'session-initialize :initilized-with)))
+    (when (or (eq session-initialize t)
+	      (memq 'de-saveplace session-initialize))
+      ;; Features of package saveplace, which has an auto-init, are covered by
+      ;; this package.
+      (when (functionp 'eval-after-load)
+	(eval-after-load "saveplace"
+	  '(progn
+	     (remove-hook 'find-file-hooks 'save-place-find-file-hook)
+	     (remove-hook 'kill-emacs-hook 'save-place-kill-emacs-hook)
+	     (remove-hook 'kill-buffer-hook 'save-place-to-alist)))))
+    (when (or (eq session-initialize t)
+	      (memq 'places session-initialize))
+      ;; `session-find-file-hook' should be *very* late in `find-file-hooks',
+      ;; esp. if some package, e.g. crypt, iso-cvt, change the buffer contents:
+      (add-hook 'find-file-hooks 'session-find-file-hook t)
+      (add-hook 'find-file-not-found-hooks 'session-find-file-not-found-hook t)
+      (add-hook 'kill-buffer-hook 'session-kill-buffer-hook)
+      (if session-register-swap-out
+	  (add-hook 'kill-buffer-hook session-register-swap-out)))
+    (when (or (eq session-initialize t) (memq 'keys session-initialize))
+      (condition-case nil
+	  (session-initialize-keys)
+	(error nil)))
+    (when (or (eq session-initialize t) (memq 'menus session-initialize))
+      (unless (memq 'session-set-file-name-history find-file-hooks)
+	;; already initialized (probably not a good idea to redo for menus)
+	(add-hook 'find-file-hooks 'session-set-file-name-history)
+	(session-initialize-menus)))
+    (when (or (eq session-initialize t)
+	      (memq 'session session-initialize))
+      (add-hook 'kill-emacs-hook 'session-save-session)
+      (or session-successful-p
+	  (setq session-successful-p
+		(and session-save-file
+		     (condition-case nil
+			 (progn
+			   ;; load might fail with coding-system = emacs-mule
+			   (unless (load session-save-file t nil t)
+			     (and session-old-save-file
+				  (load session-old-save-file t nil t)))
+			   (run-hooks 'session-after-load-save-file-hook)
+			   t)
+		       (error nil))))))
+    (put 'session-initialize :initilized-with session-initialize)))
+
+(defun session-initialize-and-set (symbol value)
+  (set-default symbol value)     ; symbol should be `session-use-package'
+  (when value
+    (if (cond-emacs-xemacs
+	 :EMACS  (and (boundp 'after-init-time) (null after-init-time))
+	 :XEMACS (null init-file-loaded))
+	;; in the meantime,`session-use-package' could have been reset to nil
+	;; (e.g. when using custom theme with t, user setting with nil)
+	(add-hook 'after-init-hook 'session-initialize-do)
+      (session-initialize-do))))
+
+;; This must be late in this file as set function is called during loading.
+(defcustom session-use-package nil
+  "Pseudo variable.  Used to initialize session in custom buffer.
+Put `(session-initialize)' into your ~/.emacs to initialize package
+session in future sessions.  See variable `session-initialize'."
+  :group 'session
+  :type '(boolean :on "in use" :off "not yet initialized or turned off"
+		  :help-echo "Use package Session, initialize if necessary.")
+  :require 'session
+  :set 'session-initialize-and-set)
+
+;;;###autoload
+(defun session-initialize ()
+  "Initialize package session and read previous session file.
+Setup hooks and load `session-save-file', see variable `session-initialize'.  At
+best, this function is called at the end of the Emacs startup, i.e., add
+this function to `after-init-hook'."
+  (interactive)
+  (put 'session-initialize :initilized-with nil)
+  (custom-set-variables '(session-use-package t nil (session))))
+
+;;; Local IspellPersDict: .ispell_session
+;;; session.el ends here
diff --git a/elisp/emacs-goodies-el/setnu.el b/elisp/emacs-goodies-el/setnu.el
new file mode 100755
index 0000000..e5b2821
--- /dev/null
+++ b/elisp/emacs-goodies-el/setnu.el
@@ -0,0 +1,448 @@
+;;; vi-style line number mode for Emacs
+;;; (requires Emacs 19.29 or later, or XEmacs 19.14 or later)
+;;; Copyright (C) 1994, 1995, 1997 Kyle E. Jones
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2, or (at your option)
+;;; any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; A copy of the GNU General Public License can be obtained from this
+;;; program's author (send electronic mail to kyle@uunet.uu.net) or from
+;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA
+;;; 02139, USA.
+;;;
+;;; Send bug reports to kyle@wonderworks.com
+;;
+;; M-x setnu-mode toggles the line number mode on and off.
+;;
+;; turn-on-setnu-mode is useful for adding to a major-mode hook
+;; variable.
+;; Example:
+;;     (add-hook 'text-mode-hook 'turn-on-setnu-mode)
+;; to automatically turn on line numbering when enterting text-mode."
+
+(provide 'setnu)
+
+(defconst setnu-running-under-xemacs
+  (or (string-match "XEmacs" emacs-version)
+      (string-match "Lucid" emacs-version)))
+
+(defconst setnu-mode-version "1.06"
+  "Version number for this release of setnu-mode.")
+
+(defvar setnu-mode nil
+  "Non-nil if setnu-mode is active in the current buffer.")
+(make-variable-buffer-local 'setnu-mode)
+
+(defvar setnu-start-extent nil
+  "First extent of a chain of extents used by setnu-mode.
+Each line has its own extent.  Each line extent has a
+`setnu-next-extent' property that points to the next extent in
+the chain, which is the extent for the next line in the buffer.
+There is also a `setnu-prev-extent' that points at the previous
+extent in the chain.  To distinguish them from other extents the
+setnu-mode extents all have a non-nil `setnu' property.")
+(make-variable-buffer-local 'setnu-start-extent)
+
+(defvar setnu-glyph-obarray (make-vector 401 0)
+  "Obarray of symbols whose values are line number glyphs.
+Each symbol name is the string represnetation of a number, perhaps
+passed with spaces.  The value of the symbol is a glyph that can
+be made the begin glyph of an extent to display as a line number.")
+
+(defvar setnu-begin-glyph-property (if (fboundp 'extent-property)
+				       'begin-glyph
+				     'before-string)
+  "Property name to use to set the begin glyph of an extent.")
+
+(defvar setnu-line-number-format (if setnu-running-under-xemacs "%4d" "%6d  ")
+  "String suitable for `format' that will generate a line number string.
+`format' will be called with this string and one other argument
+which will be an integer, the line number.")
+
+(defvar setnu-line-number-face 'bold
+  "*Face used to display the line numbers.
+Currently this works for XEmacs 19.12 and later versions only.")
+
+(defun setnu-mode (&optional arg)
+  "Toggle setnu-mode.
+With prefix argument, turn setnu-mode on if argument is positive.
+When setnu-mode is enabled, a line number will appear at the left
+margin of each line."
+  (interactive "P")
+  (let ((oldmode (not (not setnu-mode)))
+	(inhibit-quit t))
+    (setq setnu-mode (or (and arg (> (prefix-numeric-value arg) 0))
+			 (and (null arg) (null setnu-mode))))
+    (if (not (eq oldmode setnu-mode))
+	(if setnu-mode
+	    (setnu-mode-on)
+	  (setnu-mode-off)))))
+
+(defun turn-on-setnu-mode ()
+  "Turn on setnu-mode.
+Useful for adding to a major-mode hook variable.
+Example:
+    (add-hook 'text-mode-hook 'turn-on-setnu-mode)
+to automatically turn on line numbering when enterting text-mode."
+  (setnu-mode 1))
+
+;;; Internal functions
+
+;;; The program is written using XEmacs terminology,
+;;; e.g. extents, glyphs, etc.  Functions are defined to twist
+;;; the FSF Emacs overlay API into the XEmacs model.
+
+(defconst setnu-running-under-xemacs
+  (or (string-match "XEmacs" emacs-version)
+      (string-match "Lucid" emacs-version)))
+
+(if setnu-running-under-xemacs
+    (fset 'setnu-make-extent 'make-extent)
+  (fset 'setnu-make-extent 'make-overlay))
+
+(if setnu-running-under-xemacs
+    (fset 'setnu-delete-extent 'delete-extent)
+  (fset 'setnu-delete-extent 'delete-overlay))
+
+(if setnu-running-under-xemacs
+    (fset 'setnu-extent-property 'extent-property)
+  (fset 'setnu-extent-property 'overlay-get))
+
+(if setnu-running-under-xemacs
+    (fset 'setnu-set-extent-property 'set-extent-property)
+  (fset 'setnu-set-extent-property 'overlay-put))
+
+(if setnu-running-under-xemacs
+    (fset 'setnu-set-extent-endpoints 'set-extent-endpoints)
+  (fset 'setnu-set-extent-endpoints 'move-overlay))
+
+(if setnu-running-under-xemacs
+    (fset 'setnu-extent-end-position 'extent-end-position)
+  (fset 'setnu-extent-end-position 'overlay-end))
+
+(if setnu-running-under-xemacs
+    (fset 'setnu-extent-start-position 'extent-start-position)
+  (fset 'setnu-extent-start-position 'overlay-start))
+
+(if setnu-running-under-xemacs
+    (defun setnu-set-extent-begin-glyph (e g)
+      (set-extent-begin-glyph e g 'outside-margin))
+  (defun setnu-set-extent-begin-glyph (e g)
+    (overlay-put e setnu-begin-glyph-property g)))
+    
+(fset 'setnu-make-glyph (if setnu-running-under-xemacs 'make-glyph 'identity))
+
+(cond ((and setnu-running-under-xemacs (fboundp 'set-glyph-face))
+       (fset 'setnu-set-glyph-face 'set-glyph-face))
+      (setnu-running-under-xemacs
+       (fset 'setnu-set-glyph-face 'ignore))
+      (t				; FSF Emacs
+       (defun setnu-set-glyph-face (g face)
+	 (put-text-property 0 (length g) 'face face g))))
+
+(defun setnu-mode-off ()
+  "Internal shutdown of setnu-mode.
+Deletes the extents associated with setnu-mode."
+  (if (and setnu-running-under-xemacs
+	   (fboundp 'remove-specifier))
+      (remove-specifier left-margin-width (current-buffer)))
+  (if setnu-start-extent
+      (let (e ee)
+	(setq e setnu-start-extent)
+	(while e
+	  (setq ee e)
+	  (setq e (setnu-extent-property e 'setnu-next-extent))
+	  (setnu-delete-extent ee))
+	(setq setnu-start-extent nil))))
+
+(defun setnu-mode-on ()
+  "Internal startup of setnu-mode.
+Sets up the extents associated with setnu-mode."
+  (if (and setnu-running-under-xemacs
+	   (fboundp 'set-specifier))
+      (set-specifier left-margin-width 6 (current-buffer)))
+  (let ((done nil)
+	(curr-e nil)
+	(n 1)
+	(match-data (match-data))
+	e start numstr)
+    (unwind-protect
+	(save-excursion
+	  (save-restriction
+	    (widen)
+	    (goto-char (point-min))
+	    (setq start (point))
+	    (while (not done)
+	      (setq done (null (search-forward "\n" nil 0)))
+	      (setq e (setnu-make-setnu-extent start (point)))
+	      (if (null setnu-start-extent)
+		  (setq setnu-start-extent e
+			curr-e e)
+		(setnu-set-extent-property curr-e 'setnu-next-extent e)
+		(setnu-set-extent-property e 'setnu-prev-extent curr-e)
+		(setq curr-e e))
+	      (setq numstr (format setnu-line-number-format n))
+	      (setnu-set-extent-property e 'line-number numstr)
+	      (setnu-set-extent-begin-glyph e (setnu-number-glyph numstr))
+	      (setq n (1+ n)
+		    start (point)))))
+      (store-match-data match-data))))
+
+(defun setnu-before-change-function (start end)
+  "Before change function for setnu-mode.
+Notices when a delete is about to delete some lines and adjusts
+the line number extents accordingly."
+  (if (or (not setnu-mode) (= start end))
+      () ;; not in setnu-mode or this is an insertion
+    (let ((inhibit-quit t)
+	  (start-e nil)
+	  (match-data (match-data))
+	  end-e saved-next e ee)
+      (unwind-protect
+	  (save-excursion
+	    (save-restriction
+	      (widen)
+	      (goto-char start)
+	      (if (search-forward "\n" end t)
+		  (progn
+		    (setq start-e (setnu-extent-at-create start nil)
+			  saved-next (setnu-extent-property
+				      start-e
+				      'setnu-next-extent))
+		    (setq end-e (setnu-extent-at-create end nil))
+		    (setnu-set-extent-endpoints
+		     start-e
+		     (setnu-extent-start-position start-e)
+		     (setnu-extent-end-position end-e))
+		    (setnu-set-extent-property
+		     start-e 'setnu-next-extent
+		     (setnu-extent-property end-e 'setnu-next-extent))))
+	      (if start-e
+		  (progn
+		    (setq e (setnu-extent-property start-e 'setnu-next-extent)
+			  ee saved-next)
+		    (while (and e (setnu-extent-property e 'setnu-next-extent))
+		      (setq e (setnu-extent-property e 'setnu-next-extent)
+			    ee (setnu-extent-property ee 'setnu-next-extent)))
+		    (while (and e (not (eq ee start-e)))
+		      (setnu-set-extent-begin-glyph
+		       e (setnu-extent-property ee setnu-begin-glyph-property))
+		      (setnu-set-extent-property
+		       e 'line-number (setnu-extent-property ee 'line-number))
+		      (setq e (setnu-extent-property e 'setnu-prev-extent)
+			    ee (setnu-extent-property ee 'setnu-prev-extent)))
+		    (setq end-e (setnu-extent-property start-e
+						       'setnu-next-extent))
+		    (and end-e
+			 (setnu-set-extent-property end-e
+						    'setnu-prev-extent
+						    start-e))
+		    (setq e saved-next)
+		    (while (not (eq e end-e))
+		      (setq ee e
+			    e (setnu-extent-property e 'setnu-next-extent))
+		      (setnu-delete-extent ee))))))
+	(store-match-data match-data)))))
+
+(defun setnu-after-change-function (start end length)
+  "After change function for setnu-mode.
+Notices when an insert has added some lines and adjusts
+the line number extents accordingly."
+  (if (or (not setnu-mode) (= start end))
+      () ; not in setnu-mode or this is a deletion
+    (let ((inhibit-quit t)
+	  (ee nil)
+	  (match-data (match-data))
+	  (new-lines 0)
+	  start-e e saved-end saved-next n numstr)
+      (unwind-protect
+	  (save-excursion
+	    (save-restriction
+	      (widen)
+	      (setq start-e (setnu-extent-at-create start nil))
+	      (if (< (setnu-extent-end-position start-e) (point))
+		  ;; bogus!  insertion didn't put the text into
+		  ;; the extent because,
+		  ;; a. the extent was zero length or
+		  ;; b. this is FSF Emacs which means chars
+		  ;;    inserted at the end position of an extent
+		  ;;    are not inserted into the extent.
+		  (setnu-set-extent-endpoints
+		   start-e
+		   (setnu-extent-start-position start-e)
+		   end))
+	      (setq saved-next (setnu-extent-property start-e
+						      'setnu-next-extent)
+		    saved-end (setnu-extent-end-position start-e)
+		    e start-e)
+	      (goto-char start)
+	      (while (search-forward "\n" end 0)
+		(setnu-set-extent-endpoints e
+					    (setnu-extent-start-position e)
+					    (point))
+		(setq ee (setnu-make-setnu-extent (point) (point)))
+		(setnu-set-extent-property e 'setnu-next-extent ee)
+		(setnu-set-extent-property ee 'setnu-prev-extent e)
+		(setq e ee new-lines (1+ new-lines)))
+	      (if ee
+		  (progn
+		    (setnu-set-extent-endpoints
+		     e (setnu-extent-start-position e) saved-end)
+		    (setnu-set-extent-property e 'setnu-next-extent saved-next)
+		    (and saved-next
+			 (setnu-set-extent-property
+			  saved-next 'setnu-prev-extent e))
+		    (setq e (setnu-extent-property start-e 'setnu-next-extent)
+			  ee saved-next)
+		    (while ee
+		      (setnu-set-extent-begin-glyph
+		       e (setnu-extent-property ee setnu-begin-glyph-property))
+		      (setnu-set-extent-property
+		       e 'line-number (setnu-extent-property ee 'line-number))
+		      (setq e (setnu-extent-property e 'setnu-next-extent)
+			    ee (setnu-extent-property ee 'setnu-next-extent)))
+		    (setq n (1+ (string-to-int
+				 (setnu-extent-property
+				  (setnu-extent-property e 'setnu-prev-extent)
+				  'line-number))))
+		    (while e
+		      (setq numstr (format setnu-line-number-format n))
+		      (setnu-set-extent-property e 'line-number numstr)
+		      (setnu-set-extent-begin-glyph
+		       e (setnu-number-glyph numstr))
+		      (setq e (setnu-extent-property e 'setnu-next-extent)
+			    n (1+ n)))))))
+	(store-match-data match-data)))))
+
+(defun setnu-number-glyph (number-string)
+  (let ((sym (intern number-string setnu-glyph-obarray)))
+    (if (boundp sym)
+	(symbol-value sym)
+      (let ((g (setnu-make-glyph number-string)))
+	(set sym g)
+	(setnu-set-glyph-face g setnu-line-number-face)
+	g ))))
+
+(defun setnu-make-setnu-extent (beg end)
+  "Create an extent and set some properties that all setnu extents have."
+  (let ((e (setnu-make-extent beg end)))
+    (setnu-set-extent-property e 'setnu t)
+;;    (setnu-set-extent-property e 'begin-glyph-layout 'outside-margin)
+    (setnu-set-extent-property e 'detachable nil)
+    (setnu-set-extent-property e 'evaporate nil)
+    e ))
+
+(cond ((fboundp 'overlays-in) ;; expect to see this in 19.30
+       (defun setnu-extent-at (pos buf)
+	 "Finds the setnu extent at the position POS in the buffer BUF."
+	 (catch 'done
+	   (save-excursion
+	     (and buf (set-buffer buf))
+	     (let ((o-list (overlays-in pos (1+ pos))))
+	       (while o-list
+		 (if (overlay-get (car o-list) 'setnu)
+		     (throw 'done (car o-list)))
+		 (setq o-list (cdr o-list)))
+	       nil )))))
+      ((fboundp 'overlays-at)
+       (defun setnu-extent-at (pos buf)
+	 "Finds the setnu extent at the position POS in the buffer BUF."
+	 (catch 'done
+	   (save-excursion
+	     (and buf (set-buffer buf))
+	     (let ((o-list (overlays-at pos)) o-lists)
+	       ;; search what overlays-at returns first.  for all
+	       ;; but zero length extents this will return the
+	       ;; extent we want.
+	       (while o-list
+		 (if (overlay-get (car o-list) 'setnu)
+		     (throw 'done (car o-list)))
+		 (setq o-list (cdr o-list)))
+	       ;; No luck.  Search the lists returned by
+	       ;; overlay-lists.  Use overlays-recenter so we only
+	       ;; have to search the `before' lobe of the return
+	       ;; value.
+	       (overlay-recenter (1- pos))
+	       (setq o-lists (overlay-lists))
+	       (setq o-list (cdr o-lists))
+	       (while o-list
+		 (if (and (overlay-get (car o-list) 'setnu)
+			  (or (and (= pos (overlay-start (car o-list)))
+				   (= pos (overlay-end (car o-list))))
+			      (and (>= pos (overlay-start (car o-list)))
+				   (< pos (overlay-end (car o-list))))))
+		     (throw 'done (car o-list)))
+		 (setq o-list (cdr o-list)))
+	       nil )))))
+       ((fboundp 'map-extents)
+	(defun setnu-extent-at (pos buf)
+	  "Finds the setnu extent at the position POS in the buffer BUF."
+	  (map-extents (function (lambda (e maparg)
+				   (if (setnu-extent-property e 'setnu)
+				       e
+				     nil)))
+		       buf pos pos)))
+       (t (error "can't find overlays-in, overlays-at, or map-extents!")))
+
+(defun setnu-extent-at-create (pos buf)
+  "Like `setnu-extent-at' except if an extent isn't found, then
+it is created based on where the extent failed to be found."
+  (let ((e (setnu-extent-at pos buf)) ee beg numstr)
+    (if e
+	e
+      ;; no extent found so one must be created.
+      (save-excursion
+	(goto-char pos)
+	(beginning-of-line)
+	(setq e (setnu-extent-at (point) buf))
+	(cond (e
+	       ;; found one.  extend it to cover this whole line.
+	       ;; this takes care of zero length extents that
+	       ;; might exist at bob or eob that can't be
+	       ;; inserted into.
+	       (setq beg (point))
+	       (forward-line 1)
+	       (setnu-set-extent-endpoints e beg (point))
+	       e )
+	      ((bobp)
+	       ;; we are at bob and there's no extent.
+	       ;;
+	       ;; this is because the extent that was there got
+	       ;; detached because all the text in the buffer was
+	       ;; deleted.  so we create a new extent and make it
+	       ;; contain the whole buffer, since there can be no
+	       ;; other attached extents.
+	       (setq e (setnu-make-setnu-extent (point-min) (point-max))
+		     numstr (format setnu-line-number-format 1))
+	       (setnu-set-extent-property e 'line-number numstr)
+	       (setnu-set-extent-begin-glyph e (setnu-number-glyph numstr))
+	       (setq setnu-start-extent e)
+	       e )
+	      (t
+	       ;; we must be at eob and there's no extent.
+	       ;; 
+	       ;; this is because the extent that was there
+	       ;; shrank to zero length and was detached.  create
+	       ;; a new extent that contains all text from point
+	       ;; to pos.
+	       (setq e (setnu-make-setnu-extent (point) pos))
+	       (setq ee (setnu-extent-at (1- (point)) buf))
+	       (setnu-set-extent-property e 'setnu-prev-extent ee)
+	       (setnu-set-extent-property ee 'setnu-next-extent e)
+	       (setq numstr
+		     (format setnu-line-number-format
+			     (1+ (string-to-int
+				  (setnu-extent-property ee 'line-number)))))
+	       (setnu-set-extent-property e 'line-number numstr)
+	       (setnu-set-extent-begin-glyph e (setnu-number-glyph numstr))
+	       e ))))))
+
+(add-hook 'before-change-functions 'setnu-before-change-function)
+(add-hook 'after-change-functions 'setnu-after-change-function)
diff --git a/elisp/emacs-goodies-el/shell-command.el b/elisp/emacs-goodies-el/shell-command.el
new file mode 100755
index 0000000..377f196
--- /dev/null
+++ b/elisp/emacs-goodies-el/shell-command.el
@@ -0,0 +1,405 @@
+;;; shell-command.el --- enables tab-completion for `shell-command'
+
+;; Copyright (C) 1998-2007 TSUCHIYA Masatoshi 
+
+;; Author: TSUCHIYA Masatoshi 
+;; Keywords: shell
+;; Version: $Revision: 1.4 $
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, you can either send email to this
+;; program's maintainer or write to: The Free Software Foundation,
+;; Inc.; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
+
+;;; Commentary:
+
+;; This is an enhancement of shell-command, shell-command-on-region,
+;; grep, grep-find, and compile, that enables tab-completion of
+;; commands and dir/filenames within their input contexts.
+
+;; The latest version of this program can be downloaded from
+;; http://namazu.org/~tsuchiya/elisp/shell-command.el.
+
+;;; Install:
+
+;; Install this file to appropriate directory, and put these lines
+;; into your ~/.emacs.
+
+;;     (require 'shell-command)
+;;     (shell-command-completion-mode)
+
+;;; Code:
+(eval-when-compile
+  (require 'shell)
+  (require 'comint))
+
+(eval-and-compile
+  ;; Stuffs to keep compatibility between Emacsen.
+  (if (locate-library "custom")
+      (require 'custom)
+    (or (fboundp 'defgroup)
+	(defmacro defgroup (symbol members doc &rest args) nil))
+    (or (fboundp 'defcustom)
+	(defmacro defcustom (symbol value doc &rest args)
+	  (list 'defvar symbol value doc))))
+  ;; These macros, such as `when' and `unless' are imported from
+  ;; subr.el of Emacs-21.2.
+  (or (fboundp 'when)
+      (progn
+	(defmacro when (cond &rest body)
+	  "If COND yields non-nil, do BODY, else return nil."
+	  (list 'if cond (cons 'progn body)))
+	(put 'when 'edebug-form-spec '(form body))
+	(put 'when 'lisp-indent-function 1)))
+  (or (fboundp 'unless)
+      (progn
+	(defmacro unless (cond &rest body)
+	  "If COND yields nil, do BODY, else return nil."
+	  (cons 'if (cons cond (cons nil body))))
+	(put 'unless 'edebug-form-spec '(form body))
+	(put 'unless 'lisp-indent-function 1))))
+
+(defgroup shell-command nil
+  "Enable Tab completions for `shell-command' and related commands."
+  :group 'shell)
+
+(defcustom shell-command-complete-functions
+  '(shell-dynamic-complete-environment-variable
+    shell-dynamic-complete-command
+    shell-replace-by-expanded-directory
+    comint-dynamic-complete-filename)
+  "*Function list to complete shell commands."
+  :type '(repeat function)
+  :group 'shell-command)
+
+(defcustom shell-command-prompt
+  "Shell command [%w]%$ "
+  "*The prompt string for `shell-command' when tab-completion is enabled.
+Some %-sequences are available to customize this variable.  For more
+detail, see the document of `shell-command-make-prompt-string'."
+  :type 'string
+  :group 'shell-command)
+
+(defcustom shell-command-on-region-prompt
+  "Shell command on region [%w]%$ "
+  "*Prompt string of `shell-command-on-region' when tab-completion is enabled.
+Some %-sequences are available to customize this variable.  For more
+detail, see the document of `shell-command-make-prompt-string'."
+  :type 'string
+  :group 'shell-command)
+
+(defcustom shell-command-on-region-prompt-if-region-inactive
+  "Shell command on buffer [%w]%$ "
+  "*Prompt string of `shell-command-on-region' when tab-completion is enabled.
+This string is used if `shell-command-on-region' is called when
+there is no active region.
+Some %-sequences are available to customize this variable.  For more
+detail, see the document of `shell-command-make-prompt-string'."
+  :type 'string
+  :group 'shell-command)
+
+(defcustom grep-prompt
+  "Run grep [%w]%$ "
+  "*Prompt string of `grep' when tab-completion is enabled.
+Some %-sequences are available to customize this variable.  For more
+detail, see the document of `shell-command-make-prompt-string'."
+  :type 'string
+  :group 'shell-command)
+
+(defcustom grep-find-prompt
+  "Run find [%w]%$ "
+  "*Prompt string of `grep-find' when tab-completion is enabled.
+Some %-sequences are available to customize this variable.  For more
+detail, see the document of `shell-command-make-prompt-string'."
+  :type 'string
+  :group 'shell-command)
+
+(defcustom compile-prompt
+  "Compile command [%w]%$ "
+  "*Prompt string of `compile' when tab-completion is enabled.
+Some %-sequences are available to customize this variable.  For more
+detail, see the document of `shell-command-make-prompt-string'."
+  :type 'string
+  :group 'shell-command)
+
+(put 'shell-command/static-if 'lisp-indent-function 2)
+(defmacro shell-command/static-if (cond then &rest else)
+  (if (eval cond) then (cons 'progn else)))
+
+(defun shell-command-make-prompt-string (format-string current-directory) "\
+Function to generate prompt string
+
+Use FORMAT-STRING to generate prompt string at the directory
+CURRENT-DIRECTORY.  The following `%' escapes are available for use in
+FORMAT-STRING:
+
+%d     the date in \"Weekday Month Date\" format \(e.g., \"Tue May 26\"\)
+%h     the hostname up to the first `.'
+%H     the hostname
+%t     the current time in 24-hour HH:MM:SS format
+%T     the current time in 12-hour HH:MM:SS format
+%@     the current time in 12-hour am/pm format
+%u     the username of the current user
+%w     the current working directory
+%W     the basename of the current working directory
+%$     if the effective UID is 0, a #, otherwise a $
+%%     Insert a literal `%'.
+"
+  (let ((case-fold-search nil)
+	start buf
+	(list (list format-string))
+	(alist (let ((system-name (system-name))
+		     host-name
+		     fqdn-name
+		     (time (current-time))
+		     (dir (directory-file-name
+			   (abbreviate-file-name current-directory))))
+		 (shell-command/static-if (featurep 'xemacs)
+		     (cond
+		      ((string= dir (user-home-directory))
+		       (setq dir "~"))
+		      ((string-match (concat "^"
+					     (regexp-quote
+					      (file-name-as-directory
+					       (user-home-directory))))
+				     dir)
+		       (setq dir
+			     (concat "~/" (substring dir (match-end 0)))))))
+		 (if (string-match "^\\([^.]+\\)\\.[^.]" system-name)
+		     (setq fqdn-name system-name
+			   host-name (match-string 1 system-name))
+		   (setq host-name system-name
+			 fqdn-name
+			 (cond
+			  ((and (boundp 'mail-host-address)
+				(stringp mail-host-address)
+				(string-match "\\." mail-host-address))
+			   mail-host-address)
+			  ((and user-mail-address
+				(string-match "\\." user-mail-address)
+				(string-match "@\\(.*\\)\\'"
+					      user-mail-address))
+			   (match-string 1 user-mail-address))
+			  (t system-name))))
+		 `(("%%" . "%")
+		   ("%d" . ,(format-time-string "%a %b %e" time))
+		   ("%h" . ,host-name)
+		   ("%H" . ,fqdn-name)
+		   ("%t" . ,(format-time-string "%H:%M:%S" time))
+		   ("%T" . ,(format-time-string "%I:%M:%S" time))
+		   ("%@" . ,(format-time-string "%I:%M%p" time))
+		   ("%u" . ,(user-login-name))
+		   ("%w" . ,dir)
+		   ("%W" . ,(file-name-nondirectory
+			     (directory-file-name current-directory)))
+		   ("%\\$" . ,(if (= (user-uid) 0) "#" "$"))))))
+    (while alist
+      (setq buf nil)
+      (while list
+	(setq start 0)
+	(while (string-match (car (car alist)) (car list) start)
+	  (setq buf (cons (cdr (car alist))
+			  (cons (substring (car list) start
+					   (match-beginning 0))
+				buf))
+		start (match-end 0)))
+	(setq buf (cons (substring (car list) start) buf)
+	      list (cdr list)))
+      (setq list (nreverse buf)
+	    alist (cdr alist)))
+    (apply 'concat list)))
+
+(defmacro shell-command/minibuffer-prompt-end ()
+  (if (fboundp 'minibuffer-prompt-end)
+      '(minibuffer-prompt-end)
+    '(point-min)))
+
+(defun shell-command-read-minibuffer
+  (format-string current-directory &optional initial-contents
+		 user-keymap read hist)
+  "Read a command string in the minibuffer, with completion."
+  (let ((keymap (make-sparse-keymap))
+	(prompt (shell-command-make-prompt-string
+		 format-string current-directory)))
+    (set-keymap-parent keymap (or user-keymap minibuffer-local-map))
+    (define-key keymap "\t"
+      (lambda ()
+	(interactive)
+	(let ((orig-function (symbol-function 'message)))
+	  (unwind-protect
+	      (progn
+		(defun message (string &rest arguments)
+		  (let* ((s1 (concat prompt
+				     (buffer-substring
+				      (shell-command/minibuffer-prompt-end)
+				      (point-max))))
+			 (s2 (apply (function format) string arguments))
+			 (w (- (window-width)
+			       (string-width s1)
+			       (string-width s2)
+			       1)))
+		    (funcall orig-function
+			     (if (>= w 0)
+				 (concat s1 (make-string w ?\ ) s2)
+			       s2))
+		    (if (sit-for 0.3) (funcall orig-function s1))
+		    s2))
+		(require 'shell)
+		(require 'comint)
+		(run-hook-with-args-until-success
+		 'shell-command-complete-functions))
+	    (fset 'message orig-function)))))
+    (read-from-minibuffer prompt initial-contents keymap read hist)))
+
+;; This local bind of `current-load-list' is requred to keep the
+;; position where real `shell-command' is defined.  If this local bind
+;; is removed, `find-function' will tell that `shell-command' is
+;; defined in shell-command.el instaed of simple.el.
+(let (current-load-list)
+  (defadvice shell-command
+    (before shell-command-with-completion disable compile)
+    "Defined in shell-command.el, to enable tab-completion of commands
+and dir/filenames within the input context.  Its prompt string is kept
+by `shell-command-prompt'."
+    (interactive
+     (list
+      (shell-command-read-minibuffer shell-command-prompt
+				     default-directory
+				     nil nil nil 'shell-command-history)
+      current-prefix-arg))))
+
+(let (current-load-list)
+  (defadvice shell-command-on-region
+    (before shell-command-on-region-with-completion disable compile)
+    "Defined in shell-command.el, to enable tab-completion of commands
+and dir/filenames within the input context.  This advice also makes
+`shell-command-on-region' to use this current buffer as its input when
+a region is visible and inactive.
+Its prompt string is kept by `shell-command-on-region-prompt' and
+`shell-command-on-region-prompt-if-region-inactive'."
+    (interactive
+     (let (beg end prompt)
+       (if (shell-command/static-if (featurep 'xemacs)
+	       (and zmacs-regions (not (region-active-p)))
+	     (and transient-mark-mode (not mark-active)))
+	   (setq beg (point-min)
+		 end (point-max)
+		 prompt shell-command-on-region-prompt-if-region-inactive)
+	 (unless (mark)
+	   (error "The mark is not set now, so there is no region"))
+	 (setq beg (region-beginning)
+	       end (region-end)
+	       prompt shell-command-on-region-prompt))
+       (list beg end
+	     (shell-command-read-minibuffer prompt default-directory
+					    nil nil nil 'shell-command-history)
+	     current-prefix-arg
+	     current-prefix-arg
+	     shell-command-default-error-buffer)))))
+
+(let (current-load-list)
+  (defadvice grep
+    (before grep-with-completion disable compile)
+    "Defined in shell-command.el, to enable tab-completion of commands
+and dir/filenames within the input context.  Its prompt string is kept
+by `grep-prompt'."
+    (interactive
+     (let (grep-default (arg current-prefix-arg))
+       (unless grep-command
+	 (grep-compute-defaults))
+       (when arg
+	 (let* ((tag-default
+		 (funcall (or find-tag-default-function
+			      (get major-mode 'find-tag-default-function)
+			      'grep-tag-default))))
+	   (setq grep-default (or (car grep-history) grep-command))
+	   (when (string-match
+		  "[^ ]+\\s +\\(-[^ ]+\\s +\\)*\\(\"[^\"]+\"\\|[^ ]+\\)"
+		  grep-default)
+	     (setq grep-default
+		   (replace-match tag-default t t grep-default 2)))))
+       (list (shell-command-read-minibuffer grep-prompt
+					    default-directory
+					    (or grep-default grep-command)
+					    nil nil 'grep-history))))))
+
+(let (current-load-list)
+  (defadvice grep-find
+    (before grep-find-with-completion disable compile)
+    "Defined in shell-command.el, to enable tab-completion of commands
+and dir/filenames within the input context.  Its prompt string is kept
+by `grep-find-prompt'."
+    (interactive
+     (progn
+       (unless grep-find-command
+	 (grep-compute-defaults))
+       (list (shell-command-read-minibuffer grep-find-prompt
+					    default-directory
+					    grep-find-command
+					    nil nil 'grep-find-history))))))
+
+(let (current-load-list)
+  (defadvice compile
+    (before compile-with-completion disable compile)
+    "Defined in shell-command.el, to enable tab-completion of commands
+and dir/filenames within the input context.  Its prompt string is kept
+by `compile-prompt'."
+    (interactive
+     (if (or compilation-read-command current-prefix-arg)
+	 (list (shell-command-read-minibuffer compile-prompt
+					      default-directory
+					      (eval compile-command) nil nil
+					      '(compile-history . 1)))
+       (list (eval compile-command))))))
+
+(defun shell-command-custom-set (symbol value)
+  "Set SYMBOL's value to VALUE, and enable or disable tab-completion
+for following commands: `shell-command', `shell-command-on-region',
+`grep', `grep-find' and `compile'."
+  (let ((commands
+	 '(shell-command shell-command-on-region grep grep-find compile)))
+    (while commands
+      (funcall (if value 'ad-enable-advice 'ad-disable-advice)
+	       (car commands)
+	       'before
+	       (intern (concat (symbol-name (car commands))
+			       "-with-completion")))
+      (ad-activate (car commands))
+      (setq commands (cdr commands))))
+  (set-default symbol value))
+
+(defcustom shell-command-completion-mode nil
+  "*Non-nil means that tab-completion for some commands is enabled.
+The commands are `shell-command', `shell-command-on-region', `grep',
+`grep-find' and `compile'."
+  :type 'boolean
+  :set 'shell-command-custom-set
+  :group 'shell-command)
+
+;;;###autoload
+(defun shell-command-completion-mode (&optional arg)
+  "Enable or disable tab-completion for some commands.
+The commands are `shell-command', `shell-command-on-region', `grep',
+`grep-find' and `compile'."
+  (interactive "P")
+  (prog1 (shell-command-custom-set 'shell-command-completion-mode
+				   (if arg
+				       (> (prefix-numeric-value arg) 0)
+				     (not shell-command-completion-mode)))
+    (when (interactive-p)
+      (message "Tab-completion is %s"
+	       (if shell-command-completion-mode "enabled" "disabled")))))
+
+(provide 'shell-command)
+
+;;; shell-command.el ends here
diff --git a/elisp/emacs-goodies-el/show-wspace.el b/elisp/emacs-goodies-el/show-wspace.el
new file mode 100755
index 0000000..ecdf984
--- /dev/null
+++ b/elisp/emacs-goodies-el/show-wspace.el
@@ -0,0 +1,257 @@
+;;; show-wspace.el --- Highlight whitespace of various kinds.
+;;
+;; Filename: show-wspace.el
+;; Description: Highlight whitespace of various kinds.
+;; Author: Peter Steiner , Drew Adams
+;; Maintainer: Drew Adams
+;; Copyright (C) 2000-2009, Drew Adams, all rights reserved.
+;; Created: Wed Jun 21 08:54:53 2000
+;; Version: 21.0
+;; Last-Updated: Sat Aug  1 15:42:17 2009 (-0700)
+;;           By: dradams
+;;     Update #: 282
+;; URL: http://www.emacswiki.org/cgi-bin/wiki/show-wspace.el
+;; Keywords: highlight, whitespace
+;; Compatibility: GNU Emacs: 20.x, 21.x, 22.x, 23.x
+;;
+;; Features that might be required by this library:
+;;
+;;   None
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;;    Highlight whitespace of various kinds.
+;;
+;; To use this library:
+;;
+;;    Add this to your initialization file (~/.emacs or ~/_emacs):
+;;
+;;      (require 'show-wspace) ; Load this library.
+;;
+;; Then you can use commands `toggle-*' (see below) to turn the
+;; various kinds of whitespace highlighting on and off in Font-Lock
+;; mode.
+;;
+;; If you want to always use a particular kind of whitespace
+;; highlighting, by default, then add the corresponding
+;; `show-ws-highlight-*' function (see below) to the hook
+;; `font-lock-mode-hook'.  Then, whenever Font-Lock mode is turned on,
+;; whitespace highlighting will also be turned on.
+;;
+;; For example, you can turn on tab highlighting by default by adding
+;; function `show-ws-highlight-tabs' to `font-lock-mode-hook' in your
+;; .emacs file, as follows:
+;;
+;;     (add-hook 'font-lock-mode-hook 'show-ws-highlight-tabs)
+;;
+;;
+;; Faces defined here:
+;;
+;;    `show-ws-hard-space', `show-ws-tab', `show-ws-trailing-whitespace'.
+;;
+;; Commands defined here:
+;;
+;;    `show-ws-toggle-show-hard-spaces', `show-ws-toggle-show-tabs',
+;;    `show-ws-toggle-show-trailing-whitespace',
+;;    `toggle-show-hard-spaces-show-ws' (alias),
+;;    `toggle-show-tabs-show-ws' (alias),
+;;    `toggle-show-trailing-whitespace-show-ws' (alias).
+;;
+;; Non-interactive functions defined here:
+;;
+;;    `show-ws-dont-highlight-hard-spaces',
+;;    `show-ws-dont-highlight-tabs',
+;;    `show-ws-dont-highlight-trailing-whitespace',
+;;    `show-ws-highlight-hard-spaces', `show-ws-highlight-tabs',
+;;    `show-ws-highlight-trailing-whitespace'.
+;;
+;; Internal variables defined here:
+;;
+;;    `show-ws-highlight-hard-spaces-p', `show-ws-highlight-tabs-p',
+;;    `show-ws-highlight-trailing-whitespace-p'.
+;;
+;; Drew Adams wrote the `toggle-*' commands and `*-p' variables.
+;;
+;; Peter Steiner wrote the original code that did the equivalent of
+;; the `show-ws-highlight-*' commands here in his `hilite-trail.el'.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;; 2009/06/25 dadams
+;;     show-ws-dont-*: Should be no-op's for Emacs 20, 21.
+;; 2009/06/17 dadams
+;;     Added: show-ws-dont-highlight-*.
+;;     show-ws-toggle-show-*: Remove the font-lock keywords. Needed for Emacs 22+.
+;; 2007/09/25 dadams
+;;     Renamed to use prefix show-ws-.  Thx to Cyril Brulebois.
+;; 2006/11/11 dadams
+;;     Corrected doc strings.  Clarified: hard space is non-breaking space, \240.
+;;     Included hard space in highlight-trailing-whitespace.
+;; 2006/04/06 dadams
+;;     highlight-*: Use font-lock-add-keywords.  Thanks to Karl Chen.
+;; 2006/02/20 dadams
+;;     Mentioned in Commentary how to use non-interactively.
+;; 2006/01/07 dadams
+;;     Added :link for sending bug report.
+;; 2006/01/06 dadams
+;;     Added defgroup and use it.
+;; 2005/12/30 dadams
+;;     Removed require of def-face-const.el.
+;;     Renamed faces, without "-face".
+;; 2005/01/25 dadams
+;;     Removed ###autoload for defvars.
+;; 2004/06/10 dadams
+;;     Fixed minor bug in highlight-* functions.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING.  If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(and (< emacs-major-version 20) (eval-when-compile (require 'cl))) ;; when, push
+
+;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defgroup Show-Whitespace nil
+  "Highlight whitespace of various kinds."
+  :prefix "show-ws-"
+  :group 'convenience :group 'matching
+  :link `(url-link :tag "Send Bug Report"
+          ,(concat "mailto:" "drew.adams" "@" "oracle" ".com?subject=\
+show-wspace.el bug: \
+&body=Describe bug here, starting with `emacs -q'.  \
+Don't forget to mention your Emacs and library versions."))
+  :link '(url-link :tag "Other Libraries by Drew"
+          "http://www.emacswiki.org/cgi-bin/wiki/DrewsElispLibraries")
+  :link '(url-link :tag "Download"
+          "http://www.emacswiki.org/cgi-bin/wiki/show-wspace.el")
+  :link '(url-link :tag "Description"
+          "http://www.emacswiki.org/cgi-bin/wiki/ShowWhiteSpace#ShowWspace")
+  :link '(emacs-commentary-link :tag "Commentary" "show-wspace")
+  )
+
+(defface show-ws-tab '((t (:background "LemonChiffon")))
+  "*Face for highlighting tab characters (`C-i') in Font-Lock mode."
+  :group 'Show-Whitespace :group 'font-lock :group 'faces)
+
+(defface show-ws-trailing-whitespace '((t (:background "Gold")))
+  "*Face for highlighting whitespace at line ends in Font-Lock mode."
+  :group 'Show-Whitespace :group 'font-lock :group 'faces)
+
+(defface show-ws-hard-space '((t (:background "PaleGreen")))
+  "*Face for highlighting non-breaking spaces (`\240')in Font-Lock mode."
+  :group 'Show-Whitespace :group 'font-lock :group 'faces)
+
+
+(defvar show-ws-highlight-tabs-p nil
+  "Non-nil means font-lock mode highlights TAB characters (`C-i').")
+
+(defvar show-ws-highlight-trailing-whitespace-p nil
+  "Non-nil means font-lock mode highlights whitespace at line ends.")
+
+(defvar show-ws-highlight-hard-spaces-p nil
+  "Non-nil means font-lock mode highlights non-breaking spaces (`\240').")
+
+;;;###autoload
+(defalias 'toggle-show-tabs-show-ws 'show-ws-toggle-show-tabs)
+;;;###autoload
+(defun show-ws-toggle-show-tabs ()
+  "Toggle highlighting of TABs, using face `show-ws-tab'."
+  (interactive)
+  (setq show-ws-highlight-tabs-p (not show-ws-highlight-tabs-p))
+  (if show-ws-highlight-tabs-p
+      (add-hook 'font-lock-mode-hook 'show-ws-highlight-tabs)
+    (remove-hook 'font-lock-mode-hook 'show-ws-highlight-tabs)
+    (show-ws-dont-highlight-tabs))
+  (font-lock-mode) (font-lock-mode)
+  (message "TAB highlighting is now %s." (if show-ws-highlight-tabs-p "ON" "OFF")))
+
+;;;###autoload
+(defalias 'toggle-show-hard-spaces-show-ws 'show-ws-toggle-show-hard-spaces)
+;;;###autoload
+(defun show-ws-toggle-show-hard-spaces ()
+  "Toggle highlighting of non-breaking space characters (`\240').
+Uses face `show-ws-hard-space'."
+  (interactive)
+  (setq show-ws-highlight-hard-spaces-p (not show-ws-highlight-hard-spaces-p))
+  (if show-ws-highlight-hard-spaces-p
+      (add-hook 'font-lock-mode-hook 'show-ws-highlight-hard-spaces)
+    (remove-hook 'font-lock-mode-hook 'show-ws-highlight-hard-spaces)
+    (show-ws-dont-highlight-hard-spaces))
+  (font-lock-mode) (font-lock-mode)
+  (message "Hard (non-breaking) space highlighting is now %s."
+           (if show-ws-highlight-hard-spaces-p "ON" "OFF")))
+
+;;;###autoload
+(defalias 'toggle-show-trailing-whitespace-show-ws
+    'show-ws-toggle-show-trailing-whitespace)
+;;;###autoload
+(defun show-ws-toggle-show-trailing-whitespace ()
+  "Toggle highlighting of trailing whitespace.
+Uses face `show-ws-trailing-whitespace'."
+  (interactive)
+  (setq show-ws-highlight-trailing-whitespace-p
+        (not show-ws-highlight-trailing-whitespace-p))
+  (if show-ws-highlight-trailing-whitespace-p
+      (add-hook 'font-lock-mode-hook 'show-ws-highlight-trailing-whitespace)
+    (remove-hook 'font-lock-mode-hook 'show-ws-highlight-trailing-whitespace)
+    (show-ws-dont-highlight-trailing-whitespace))
+  (font-lock-mode) (font-lock-mode)
+  (message "Trailing whitespace highlighting is now %s."
+           (if show-ws-highlight-trailing-whitespace-p "ON" "OFF")))
+
+(defun show-ws-highlight-tabs ()
+  "Highlight tab characters (`C-i')."
+  (font-lock-add-keywords nil '(("[\t]+" (0 'show-ws-tab t)))))
+(defun show-ws-highlight-hard-spaces ()
+  "Highlight hard (non-breaking) space characters (`\240')."
+  (font-lock-add-keywords nil '(("[\240]+" (0 'show-ws-hard-space t)))))
+(defun show-ws-highlight-trailing-whitespace ()
+  "Highlight whitespace characters at line ends."
+  (font-lock-add-keywords
+   nil '(("[\240\040\t]+$" (0 'show-ws-trailing-whitespace t)))))
+
+;; These are no-ops for Emacs 20, 21:
+;; `font-lock-remove-keywords' is not defined, and we don't need to use it.
+(defun show-ws-dont-highlight-tabs ()
+  "Don't highlight tab characters (`C-i')."
+  (when (fboundp 'font-lock-remove-keywords)
+    (font-lock-remove-keywords nil '(("[\t]+" (0 'show-ws-tab t))))))
+
+(defun show-ws-dont-highlight-hard-spaces ()
+  "Don't highlight hard (non-breaking) space characters (`\240')."
+  (when (fboundp 'font-lock-remove-keywords)
+    (font-lock-remove-keywords nil '(("[\240]+" (0 'show-ws-hard-space t))))))
+
+(defun show-ws-dont-highlight-trailing-whitespace ()
+  "Don't highlight whitespace characters at line ends."
+  (when (fboundp 'font-lock-remove-keywords)
+    (font-lock-remove-keywords
+     nil '(("[\240\040\t]+$" (0 'show-ws-trailing-whitespace t))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;
+
+(provide 'show-wspace)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; show-wspace.el ends here
diff --git a/elisp/emacs-goodies-el/silly-mail.el b/elisp/emacs-goodies-el/silly-mail.el
new file mode 100755
index 0000000..42a022d
--- /dev/null
+++ b/elisp/emacs-goodies-el/silly-mail.el
@@ -0,0 +1,752 @@
+;;; silly-mail.el --- generate bozotic mail headers
+
+;; Compilation Copyright (C) 1993, 94, 95, 96, 97, 98, 99, 2000 Noah S. Friedman
+
+;; Contributors: Noah Friedman, Jamie Zawinski, Jim Blandy,
+;;               Thomas Bushnell, Roland McGrath,
+;;               and a cast of dozens.
+;; Maintainer: Noah Friedman 
+;; Keywords: extensions, mail
+;; Status: works in Emacs 19 and XEmacs.
+
+;; $Id: silly-mail.el,v 1.4 2013/12/04 22:32:10 psg Exp $
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, you can either send email to this
+;; program's maintainer or write to: The Free Software Foundation,
+;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; To use this, put the following in your .emacs:
+;;
+;;    (autoload 'sm-add-random-header "silly-mail" nil t)
+;;    (add-hook 'mail-setup-hook 'sm-add-random-header)
+
+;; I solicit more randomly generated headers commands.
+
+;; Some of the options in this program require some external packages which
+;; are not a standard part of emacs, e.g. shop.el and flame.el (flame.el is
+;; present in XEmacs and Emacs 18, but missing from Emacs 19).  These are
+;; available from http://www.splode.com/users/friedman/software/emacs-lisp/
+
+;;; Code:
+
+(require 'sendmail)
+
+(random t)
+
+(defvar sm-mail-header-table
+  '(sm-add-antipastobozoticataclysm
+    (sm-add-at&t-hype           youwill             "youwill")
+    sm-add-drdoom-fodder
+    sm-add-emacs-name
+    sm-add-emacs-taunt
+    (sm-add-flame               *flame              "flame")
+    (sm-add-horoscope           horoscope           "horoscope")
+    (sm-add-kibology            kibologize          "kibologize")
+    sm-add-meat
+    sm-add-microsoft
+    sm-add-nsa-fodder
+    (sm-add-shopping-list       shop-string         "shop")
+    sm-add-tom-swifty
+    sm-add-tomato
+    (sm-add-uboat-death-message uboat-death-message "uboat")
+    sm-add-x-taunt
+    sm-add-zippy-quote)
+  "List of routines which generate silly mail headers.
+Each element is either a symbol or a list.
+If an element is a function, that function can be called.
+If an element is a list, it is composed of three elements:
+   1. A function to call which generates a header.
+   2. A symbol naming a function required by the header-generator.
+      If this function is not defined, the header-generator cannot run.
+   3. The name of a library to load if the required function isn't defined.
+      If the load fails, or if `sm-load-missing-libraries' is `nil',
+      the corresponding header-generator function won't be used.")
+
+(defvar sm-load-missing-libraries t
+  "*If non-`nil', load missing libraries for header functions.
+If nil, then if a library is not already loaded, the dependent
+header-generating function will not be used.")
+
+;;;###autoload
+(defun sm-add-random-header ()
+  "Insert a random silly mail header.
+The choice of available headers is taken from sm-mail-header-table."
+  (interactive)
+  (funcall (sm-random-header-function)))
+
+;;;###autoload
+(defun sm-add-all-headers ()
+  "Insert one of every kind of silly mail header defined.
+The choice of available headers is taken from sm-mail-header-table."
+  (interactive)
+  (let ((fns sm-mail-header-table)
+        fn)
+    (while fns
+      (setq fn (sm-use-header-function-p (car fns)))
+      (and fn
+           (funcall fn))
+      (setq fns (cdr fns)))))
+
+(defun sm-random-header-function ()
+  (let ((fn nil))
+    (while (null fn)
+      (setq fn (sm-use-header-function-p
+                (nth (random (length sm-mail-header-table))
+                     sm-mail-header-table))))
+    fn))
+
+
+(defun sm-use-header-function-p (func)
+  (cond ((consp func)
+         (let ((fn (nth 0 func))
+               (fbound-sym (nth 1 func))
+               (lib (nth 2 func)))
+           (cond ((fboundp fbound-sym)
+                  fn)
+                 ((and sm-load-missing-libraries
+                       (load lib t)
+                       (fboundp fbound-sym))
+                  fn))))
+        (t func)))
+
+
+(defvar sm-fill-single-line-width   78)
+(defvar sm-fill-multi-line-width    70)
+(defvar sm-fill-indent-width         3)
+
+(defun sm-sequence-item (sequence n)
+  (cond ((or (vectorp sequence)
+             (stringp sequence))
+         (aref sequence n))
+        ((listp sequence)
+         (nth n sequence))
+        (t
+         (signal 'domain-error (list 'sequencep sequence)))))
+
+(defsubst sm-random-sequence-item (sequence)
+  (sm-sequence-item sequence (random (length sequence))))
+
+(defsubst sm-random-range (lower upper)
+  (+ lower (random (- upper lower))))
+
+(defun sm-random-sequence-items (&optional sequence lower upper)
+  (and (null lower)
+       (setq lower 0))
+  (let ((seqlen (length sequence))
+        (count (if upper
+                   (sm-random-range lower upper)
+                 (random lower)))
+        items tem)
+    (while (not (zerop count))
+      (setq tem (sm-sequence-item sequence (random seqlen)))
+      (or (memq tem items)
+          (setq items (cons tem items)
+                count (1- count))))
+    items))
+
+(defun sm-put-header-fill-content (header contents)
+  (let ((buf (generate-new-buffer " *sm-temp*"))
+        (header-length (+ 2 (length header)))
+        (single-width sm-fill-single-line-width)
+        (multi-width sm-fill-multi-line-width)
+        (indent-width sm-fill-indent-width)
+        (do-fill (function
+                  (lambda (fill-column)
+                    (fill-region-as-paragraph (point-min) (point-max))
+                    ;; Emacs 19 fill functions add an extra newline
+                    (cond ((char-equal ?\C-j (char-after (1- (point-max))))
+                           (goto-char (point-max))
+                           (delete-char -1)))
+                    (= (count-lines (point-min) (point-max)) 1)))))
+    (save-excursion
+      (set-buffer buf)
+      (insert contents)
+      (cond
+       ((funcall do-fill (- single-width header-length)))
+       (t
+        (or (funcall do-fill (- single-width indent-width))
+            (funcall do-fill (- multi-width indent-width)))
+        (goto-char (point-min))
+        (insert "\n")
+        (indent-rigidly (point-min) (point-max) indent-width)))
+      (setq contents (buffer-string))
+      (kill-buffer buf)))
+  (sm-put-header header contents))
+
+(defsubst sm-put-random-sequence-items (header sequence &optional range)
+  (sm-put-header-contents header
+    (apply 'sm-random-sequence-items sequence range)))
+
+(defsubst sm-put-header-multiline-content (header items)
+  (sm-put-header-contents header
+    items
+    (concat "\n" (make-string sm-fill-indent-width ?\040))))
+
+(defsubst sm-put-header-contents (header items &optional separator)
+  (sm-put-header header
+    (mapconcat 'identity items (or separator " "))))
+
+(defun sm-put-random-sequence-items-to-eol (header sequence &optional sep)
+  (or sep (setq sep " "))
+  (let ((width (- sm-fill-single-line-width (length header) 2))
+        (seqlen (length sequence))
+        (len 0)
+        (continuep t)
+        items tem new-len)
+    (while continuep
+      (setq tem (sm-sequence-item sequence (random seqlen)))
+      (setq newlen (+ len (length sep) (length tem)))
+      (cond ((and (> newlen width)
+                  (consp items))
+             (setq continuep nil))
+            ((memq tem items))
+            (t
+             (setq items (cons tem items))
+             (setq len newlen))))
+    (sm-put-header header (mapconcat 'identity items sep))))
+
+;; Add the specified header to the current mail message, with the given
+;; contents.  If the header already exists, its contents are replaced.
+(defun sm-put-header (header contents)
+  (save-excursion
+    (let ((buf-mod-p (buffer-modified-p))
+          (header-exists (mail-position-on-field header)))
+      (if header-exists
+          (let ((end (point))
+                (beg (progn
+                       (re-search-backward (concat header ": "))
+                       (goto-char (match-end 0)))))
+            (delete-region beg end)))
+      (insert contents)
+      (set-buffer-modified-p buf-mod-p))))
+
+(put 'sm-put-header-fill-content 'lisp-indent-function 1)
+(put 'sm-put-header-contents 'lisp-indent-function 1)
+(put 'sm-put-header 'lisp-indent-function 1)
+
+
+;; A private joke
+
+(defvar sm-antipastobozoticataclysm-header
+  "X-Antipastobozoticataclysm")
+
+(defvar sm-antipastobozoticataclysm-table
+  ["Bariumenemanilow"
+   "When George Bush projectile vomits antipasto on the Japanese."])
+
+(defun sm-add-antipastobozoticataclysm ()
+  (interactive)
+  (sm-put-header-fill-content sm-antipastobozoticataclysm-header
+    (sm-random-sequence-item sm-antipastobozoticataclysm-table)))
+
+
+(defvar sm-at&t-hype-header "X-AT&T-Hype")
+
+(defun sm-add-at&t-hype ()
+  (interactive)
+  (require 'youwill)
+  (sm-put-header-fill-content sm-at&t-hype-header (youwill)))
+
+
+;; This is sort of based on the same principle as the NSA Fodder header.
+;; In 1991, the MOD used to break into the FSF machines and read our email,
+;; looking for security-related information.
+
+(defvar sm-drdoom-fodder-header "X-Drdoom-Fodder")
+
+(defvar sm-drdoom-fodder-words
+  ["CERT" "crash" "crypt" "drdoom" "passwd" "security" "root" "satan"])
+
+(defvar sm-drdoom-fodder-length-range
+  (list 5 (length sm-drdoom-fodder-words)))
+
+(defun sm-add-drdoom-fodder ()
+  (interactive)
+  (sm-put-random-sequence-items sm-drdoom-fodder-header
+                                sm-drdoom-fodder-words
+                                sm-drdoom-fodder-length-range))
+
+
+(defvar sm-emacs-name-header "X-Emacs-Acronym")
+
+;; These have been contributed by people all over the network
+;; (see the file etc/JOKES or emacs.names in the Emacs 19 distribution).
+;; I modified some of them.
+(defvar sm-emacs-name-table
+  ["Each Mail A Continued Surprise"
+   "Each Manual's Audience is Completely Stupified"
+   "Easily Maintained with the Assistance of Chemical Solutions"
+   "Easily Mangles, Aborts, Crashes and Stupifies"
+   "Eating Memory And Cycle-Sucking"
+   "Editing MACroS"
+   "Edwardian Manifestation of All Colonial Sins"
+   "Egregious Managers Actively Court Stallman"
+   "Eight Megabytes And Constantly Swapping"
+   "Eleven Monkeys Asynchronously Create Slogans"
+   "Elsewhere Maybe All Commands are Simple"
+   "Elsewhere Maybe Alternative Civilizations Survive"
+   "Elvis Masterminds All Computer Software"
+   "Emacs Macht Alle Computer Schoen"
+   "Emacs Made Almost Completely Screwed"
+   "Emacs Maintainers Are Crazy Sickos"
+   "Emacs Makes A Computer Slow"
+   "Emacs Makes All Computing Simple"
+   "Emacs Manuals Always Cause Senility"
+   "Emacs Manuals Are Cryptic and Surreal"
+   "Emacs Masquerades As Comfortable Shell"
+   "Emacs May Alienate Clients and Supporters"
+   "Emacs May Allow Customised Screwups"
+   "Emacs May Annihilate Command Structures"
+   "Emacs Means A Crappy Screen"
+   "Emacs: My Alternative Computer Story"
+   "Embarrassed Manual-Writer Accused of Communist Subversion"
+   "Embarrassingly Mundane Advertising Cuts Sales"
+   "Emetic Macros Assault Core and Segmentation"
+   "Energetic Merchants Always Cultivate Sales"
+   "Equine Mammals Are Considerably Smaller"
+   "Eradication of Memory Accomplished with Complete Simplicity"
+   "Erasing Minds Allows Complete Submission"
+   "Escape Meta Alt Control Shift"
+   "Esoteric Malleability Always Considered Silly"
+   "Even My Aunt Crashes the System"
+   "Even a Master of Arts Comes Simpler"
+   "Evenings, Mornings, And a Couple of Saturdays"
+   "Eventually Munches All Computer Storage"
+   "Ever Made A Control-key Setup?"
+   "Every Male Adolescent Craves Sex"
+   "Every Mode Accelerates Creation of Software"
+   "Every Mode Acknowledges Customized Strokes"
+   "Every Moron Assumes CCA is Superior"
+   "Everyday Material Almost Compiled Successfully"
+   "Excavating Mayan Architecture Comes Simpler"
+   "Excellent Manuals Are Clearly Suppressed"
+   "Exceptionally Mediocre Algorithm for Computer Scientists"
+   "Exceptionally Mediocre Autocratic Control System"
+   "Experience the Mildest Ad Campaign ever Seen"
+   "Extended Macros Are Considered Superfluous"
+   "Extensibility and Modifiability Aggravate Confirmed Simpletons"
+   "Extraneous Macros And Commands Stink"
+   "Generally Not Used (Except by Middle Aged Computer Scientists)"]
+  "EMACS acronym expansions.")
+
+(defun sm-add-emacs-name ()
+  (interactive)
+  (sm-put-header sm-emacs-name-header
+    (sm-random-sequence-item sm-emacs-name-table)))
+
+
+;; Jim Blandy (and possibly Karl Fogel?) started this and contributed
+;; most of the phrases.
+
+(defvar sm-emacs-taunt-header "Emacs")
+
+(defvar sm-emacs-taunt-table
+  '["(setq software-quality (/ 1 number-of-authors))"
+    "a Lisp interpreter masquerading as ... a Lisp interpreter!"
+    "a compelling argument for pencil and paper."
+    "a learning curve that you can use as a plumb line."
+    "a real time environment for simulating molasses-based life forms."
+    "an inspiring example of form following function... to Hell."
+    "anything free is worth what you paid for it."
+    "ballast for RAM."
+    "because Hell was full."
+    "because editing your files should be a traumatic experience."
+    "because extension languages should come with the editor built in."
+    "because idle RAM is the Devil's playground."
+    "because one operating system isn't enough."
+    "because you deserve a brk today."
+    "don't cry -- it won't help."
+    "don't try this at home, kids!"
+    "ed  ::  20-megaton hydrogen bomb : firecracker"
+    "featuring the world's first municipal garbage collector!"
+    "freely redistributable; void where prohibited by law."
+    "if SIGINT doesn't work, try a tranquilizer."
+    "if it payed rent for disk space, you'd be rich."
+    "impress your (remaining) friends and neighbors."
+    "it's all fun and games, until somebody tries to edit a file."
+    "it's like swatting a fly with a supernova."
+    "it's not slow --- it's stately."
+    "Lovecraft was an optimist."
+    "more boundary conditions than the Middle East."
+    "more than just a Lisp interpreter, a text editor as well!"
+    "no job too big... no job."
+    "or perhaps you'd prefer Russian Roulette, after all?"
+    "Our Lady of Perpetual Garbage Collection"
+    "resistance is futile; you will be assimilated and byte-compiled."
+    "the Swiss Army of Editors."
+    "the answer to the world surplus of CPU cycles."
+    "the definitive fritterware."
+    "the only text editor known to get indigestion."
+    "the prosecution rests its case."
+    "the road to Hell is paved with extensibility."
+    "there's a reason it comes with a built-in psychotherapist."
+    "well, why *shouldn't* you pay property taxes on your editor?"
+    "where editing text is like playing Paganini on a glass harmonica."
+    "you'll understand when you're older, dear."]
+  "Facts about Emacs that you and your loved ones should be aware of.")
+
+(defun sm-add-emacs-taunt ()
+  (interactive)
+  (sm-put-header sm-emacs-taunt-header
+    (sm-random-sequence-item sm-emacs-taunt-table)))
+
+(setq bizarre-gratuitous-variable '(miscellaneous gratuitous list))
+
+
+;; Add an insulting flame into your mail headers.
+
+(defvar sm-flame-header "X-Flame")
+
+(defun sm-add-flame ()
+  (interactive)
+  (or (fboundp '*flame)
+      (fboundp 'flame-string)
+      (load "flame"))
+  (sm-put-header-fill-content sm-flame-header
+    (if (fboundp 'flame-string)
+        ;; friedman's flame.el
+        (flame-string)
+      ;; XEmacs/Emacs-18 flame.el
+      (sentence-ify (string-ify (append-suffixes-hack
+                                 (flatten (*flame))))))))
+
+
+(defvar sm-horoscope-header "X-Horoscope")
+
+(defun sm-add-horoscope ()
+  (interactive)
+  (require 'horoscope)
+  (sm-put-header-fill-content sm-horoscope-header (horoscope)))
+
+
+;; Add words of wisdom from the grepmeister.
+
+(defvar sm-kibology-header "X-Kibo-Says")
+
+(defun sm-add-kibology ()
+  (interactive)
+  (require 'kibologize)
+  (sm-put-header-fill-content sm-kibology-header (kibologize)))
+
+
+;; Contributed by David LaMacchia 
+
+(defvar sm-meat-header "X-Meat")
+
+(defvar sm-meat-table
+  ["Abalone"
+   "Back Bacon"
+   "Bacon"
+   "Beef Jerky"
+   "Biltong"  ; african-style jerky, usually beef, ostrich, or antelope
+   "Blood sausage"
+   "Buffalo"
+   "Calimari"
+   "Chicken Fried Steak"
+   "Chicken"
+   "Clam Jerky"
+   "Duck"
+   "Flanken"
+   "Haggis"
+   "Ham"
+   "Head cheese"
+   "Liverwurst"
+   "Lobster"
+   "Long pork"
+   "Molinari"
+   "Olive Loaf"
+   "Parma"
+   "Prosciutto"
+   "Ptarmigan"
+   "Roo burgers"
+   "Salame"
+   "Spruce grouse"
+   "Squirrel"
+   "Swordfish"
+   "Turkey Jerky"
+   "Veal"
+   "Venison"
+   "Wallaby steak"])
+
+(defun sm-add-meat ()
+  (interactive)
+  (sm-put-header sm-meat-header
+    (sm-random-sequence-item sm-meat-table)))
+
+
+;; From Karl Fogel 
+
+(defvar sm-microsoft-header "Microsoft")
+
+(defvar sm-microsoft-table
+  ["I'm not laughing anymore."
+   "Making the world a better place... for Microsoft."
+   "Programs so large they have weather."
+   "We've got the solution for the problem we sold you."
+   "Where `market lock-in' means throwing away the keys."
+   "Where even the version numbers aren't Y2K-compliant"
+   "Where the service packs are larger than the original releases."
+   "With our software, there's no limit to what you can't do!"
+   "World domination wasn't enough -- we had to write bad software, too!"])
+
+(defun sm-add-microsoft ()
+  (interactive)
+  (sm-put-header sm-microsoft-header
+    (sm-random-sequence-item sm-microsoft-table)))
+
+
+(defvar sm-nsa-header "X-NSA-Fodder")
+
+(defun sm-add-nsa-fodder ()
+  (interactive)
+  (or (fboundp 'snarf-spooks) (load "spook"))
+  (sm-put-random-sequence-items-to-eol sm-nsa-header (snarf-spooks)))
+
+
+;; Inspiration for this came from Brian Rice, a sicko genius.
+
+(defvar sm-shopping-list-header "X-Shopping-List")
+
+(defvar sm-shopping-list-count '(3 . 6))
+(defvar sm-shopping-list-multi-line-p t)
+
+(defun sm-add-shopping-list (&optional item-count)
+  (interactive "P")
+  (require 'shop)
+  (cond ((or (null item-count)
+             (and (consp item-count)
+                  (null (cdr item-count))))
+         (setq item-count sm-shopping-list-count)))
+  (let ((items (shop-string-numbered-list (if (consp item-count)
+                                              (shop-random-range
+                                               (car item-count)
+                                               (cdr item-count))
+                                            item-count))))
+    (cond (sm-shopping-list-multi-line-p
+           (sm-put-header-multiline-content sm-shopping-list-header
+                                            (cons "" items)))
+          (t
+           (sm-put-header-contents sm-shopping-list-header items "; ")))))
+
+
+;; Tom Swifties.  Blame for these go mainly to Noah Friedman
+;; and Thomas (nee Michael) Bushnell.
+
+(defvar sm-tom-swifty-header "X-Tom-Swifty")
+
+(defvar sm-tom-swifty-table
+  '["\"All the cherry trees are dead,\" Tom said fruitlessly."
+    "\"And what should you set your PS1 shell variable to?\" Tom prompted."
+    "\"Any fresh fruit in the kitchen?\" Tom asked peeringly."
+    "\"C++ is the wave of the future,\" Tom said objectively."
+    "\"Care for some `suan la chow show'?\" Tom asked wantonly."
+    "\"Condensed chicken soup,\" was Tom's canned response."
+    "\"Darling, what vegetable becomes an act of passion when misspelled?\", Tom breathed ravishingly."
+    "\"Eat me,\" was Tom's biting response."
+    "\"Ed is the Standard Text Editor,\" Tom sed."
+    "\"Evergreens have always been my favorite,\" Tom opined."
+    "\"He came at me out of the blue,\" Tom said airily."
+    "\"I am writing lots of little verses,\"  Tom said blankly."
+    "\"I can't drink alcohol,\" Tom said spiritually."
+    "\"I can't get this fire started,\" Tom said woodenly."
+    "\"I can't stand baby food,\" Tom said in a strained voice."
+    "\"I can't wait to see the doctor,\" Tom said impatiently."
+    "\"I don't WANNA get drunk,\" Tom wined."
+    "\"I don't have any piano music,\"  Tom said listlessly."
+    "\"I don't have the slightest idea how to milk this cow,\" Tom said in utter confusion."
+    "\"I don't understand how square roots work,\" Tom said irrationally."
+    "\"I don't want any champagne!\" Tom said, blowing his top."
+    "\"I feel like I'm running around in circles,\"  Tom said squarely."
+    "\"I got to get a text-processor that does my files the right way,\" Tom said awkwardly."
+    "\"I guess I shouldn't have broken the mirror,\" Tom reflected."
+    "\"I hate Frere Jacques,\" Tom said as he roundly denounced it."
+    "\"I have no intention of traversing binary trees!\", Tom barked."
+    "\"I have to finish sorting these writing utensils,\" Tom said pensively."
+    "\"I hope this emulsion works,\" Tom said in suspense."
+    "\"I just burned my hand in the blast furnace,\" Tom said, overwrought."
+    "\"I just don't understand the number seventeen,\" Tom said randomly."
+    "\"I just got some chicken wire,\" Tom said defensively."
+    "\"I just poisoned myself,\" Tom lyed."
+    "\"I just sharpened my pencil,\" Tom said pointedly."
+    "\"I like Gregorian chants,\" Tom intoned."
+    "\"I like amputations,\" Tom said disarmingly."
+    "\"I like sun cartridge tapes,\" Tom said quickly."
+    "\"I never get good bridge hands,\" Tom said in passing."
+    "\"I only like black and white,\" Tom said monotonously."
+    "\"I really like penguins,\" Tom said in a flighty voice."
+    "\"I recommend listening to radio station ``WHAT'',\" Tom said quietly."
+    "\"I think it's time we got married,\" Tom said engagingly."
+    "\"I train dolphins,\" Tom said purposefully."
+    "\"I'll have to grade your test again,\" Tom remarked."
+    "\"I'm completely bankrupt,\" Tom said senselessly."
+    "\"I'm fond of Pavarotti,\" Tom said menacingly."
+    "\"I'm gainfully employed at the Weight-Watchers gymnasium,\" Tom said wastefully."
+    "\"I'm getting fat,\" Tom said expansively."
+    "\"I'm going to copy this tape,\" Tom said for the record."
+    "\"I'm hardly ever aware of what I'm going to do next,\" Tom said unconsciously."
+    "\"I'm having deja-vu,\" Tom said again."
+    "\"I'm really bored,\" Tom said flatly."
+    "\"I'm sorry I broke your window,\" Tom said painfully."
+    "\"I'm sorry to hear I knocked you up,\" Tom said after a pregnant pause."
+    "\"I've burned my tongue,\" Tom said distastefully."
+    "\"I've finished counting the horses,\" Tom said summarily."
+    "\"I've got a bucket full of forearms,\" Tom said wistfully."
+    "\"I've just been drafted,\"  Tom said impressively."
+    "\"I've made a complete ash of myself,\" Tom said brazenly."
+    "\"IBM is up 3 points,\" Tom said, taking stock of the situation."
+    "\"If only we could piece together this crime,\" Tom said in a puzzled voice."
+    "\"It needs more seasoning,\" Tom said sagely."
+    "\"It's patently obvious,\" Tom said licentiously."
+    "\"It's really cold out here,\" Tom said in a muffled voice."
+    "\"It's really windy outside,\" said Tom with gusto."
+    "\"Lisp is such a symbol-minded language,\" Tom commonly said."
+    "\"My feet hurt,\" Tom said pedantically."
+    "\"My lenses will stay perfectly clear,\" Tom said optimistically."
+    "\"My mouse buttons don't work,\" Tom said in a depressed voice."
+    "\"My terminal is completely screwed up,\" Tom cursed."
+    "\"On the other hand, eating at a table is more civilized,\" Tom countered."
+    "\"Quick!  Change the baby's diaper,\" Tom said rashly."
+    "\"Socialism is dead,\" Tom communicated."
+    "\"The ASCII standard sucks,\" Tom said characteristically."
+    "\"The GNU project will probably not be Posix conformant,\" Tom said noncommittally."
+    "\"The judge sentenced him to the chair,\" Tom said dielectrically."
+    "\"The printer is using too much toner,\"  Tom said darkly."
+    "\"The rooster was decapitated,\" Tom said in a crestfallen voice."
+    "\"The sequence `M-4' is equivalent to `C-u 4',\" Tom said metaphorically."
+    "\"The sky is falling,\" Tom said in a crushed voiced."
+    "\"The sun just rose over the cemetary,\" Tom said in mourning."
+    "\"This anesthetic isn't very effective,\" Tom said unnervingly."
+    "\"This awl is broken,\" Tom said pointlessly."
+    "\"This is illegal, I just know it,\" Tom said with conviction."
+    "\"Turn that fan off,\" Tom said coldly."
+    "\"VI is much better than EMACS,\" Tom said with joy."
+    "\"Wait! You need to enable interrupts first!\" Tom said preemptorally."
+    "\"We'll have to take the stairs,\" Tom said in an elevated voice."
+    "\"We're all out of flowers,\" Tom said lackadaisically."
+    "\"We're going to sue you for that window system,\" Tom said inexorably."
+    "\"We're going to use decimal notation,\" Tom said tentatively."
+    "\"Well, I guess we should pitch camp,\" Tom said tentatively."
+    "\"Well, it didn't increase at all,\" Tom said, nonplussed."
+    "\"What is today's date?\" Tom asked in a timely fashion."
+    "\"When will the Hurd be released?\" Tom asked Machingly."
+    "\"Who drank the last beer?\" Tom asked, hopping mad."
+    "\"You have new mail,\" Tom said in his usual delivery."
+    "\"You light up my life,\" Tom said brightly."
+    "\"You pinhead,\" Tom said pointedly."])
+
+(defun sm-add-tom-swifty ()
+  (interactive)
+  (sm-put-header-fill-content sm-tom-swifty-header
+    (sm-random-sequence-item sm-tom-swifty-table)))
+
+
+;; I think Lars Bader came up with this one first.
+;; Lately Jim Blandy and others have used it also.
+;;
+;; It's a test to see if any mailers break because they can't actually
+;; implement oddly-colored tomatos, or something like that.
+
+(defvar sm-tomato-header "Tomato")
+
+(defvar sm-tomato-table
+  ["Beige"
+   "Green"
+   "Heliotrope"
+   "Mauve"
+   "Plaid"
+   "Polka-dot"])
+
+(defun sm-add-tomato ()
+  (interactive)
+  (sm-put-header sm-tomato-header
+    (sm-random-sequence-item sm-tomato-table)))
+
+
+(defvar sm-uboat-death-message-header "X-Uboat-Death-Message")
+
+(defun sm-add-uboat-death-message ()
+  (interactive)
+  (require 'uboat)
+  (sm-put-header-fill-content sm-uboat-death-message-header
+    (uboat-death-message)))
+
+
+;; Most of these came from the unix-haters mailing list.
+;; Jamie Zawinski added more later.
+
+(defvar sm-x-taunt-header "X-Windows")
+
+(defvar sm-x-taunt-table
+  '["a mistake carried out to perfection."
+    "a moment of convenience, a lifetime of regret."
+    "a terminal disease."
+    "all the problems and twice the bugs."
+    "complex nonsolutions to simple nonproblems."
+    "dissatisfaction guaranteed."
+    "don't get frustrated without it."
+    "even not doing anything would have been better than nothing."
+    "even your dog won't like it."
+    "flaky and built to stay that way."
+    "flawed beyond belief."
+    "foiled again."
+    "form follows malfunction."
+    "garbage at your fingertips."
+    "graphics hacking :: Roman numerals : sqrt (pi)"
+    "ignorance is our most important resource."
+    "it could be worse, but it'll take time."
+    "it could happen to you."
+    "it was hard to write; it should be hard to use."
+    "let it get in *your* way."
+    "live the nightmare."
+    "more than enough rope."
+    "never had it, never will."
+    "no hardware is safe."
+    "power tools for power fools."
+    "power tools for power losers."
+    "putting new limits on productivity."
+    "simplicity made complex."
+    "some voids are better left unfilled."
+    "sometimes you fill a vacuum and it still sucks."
+    "the art of incompetence."
+    "the cutting edge of obsolescence."
+    "the defacto substandard."
+    "the first fully modular software disaster."
+    "the joke that kills."
+    "the problem for your problem."
+    "there's got to be a better way."
+    "warn your friends about it."
+    "you'd better sit down."
+    "you'll envy the dead."]
+  "What users said as they collapsed.")
+
+(defun sm-add-x-taunt ()
+  (interactive)
+  (sm-put-header sm-x-taunt-header
+    (sm-random-sequence-item sm-x-taunt-table)))
+
+
+;; Yow!  Am I quoted in your EMAIL yet?
+
+(defvar sm-zippy-quote-header "X-Zippy-Says")
+
+(defun sm-add-zippy-quote ()
+  (interactive)
+  (or (fboundp 'yow) (load "yow"))
+  (sm-put-header-fill-content sm-zippy-quote-header (yow)))
+
+(provide 'silly-mail)
+
+;;; silly-mail.el ends here.
diff --git a/elisp/emacs-goodies-el/slang-mode.el b/elisp/emacs-goodies-el/slang-mode.el
new file mode 100755
index 0000000..d79b900
--- /dev/null
+++ b/elisp/emacs-goodies-el/slang-mode.el
@@ -0,0 +1,709 @@
+;;; slang-mode.el --- a major-mode for editing slang scripts
+
+;; Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc.
+
+;; Modified By: Joe Robertson 
+;; Modified From: tcl-mode.el
+;; 
+;; Original Author: Gregor Schmid 
+;; Keywords: languages, processes, tools
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Add these lines to your .emacs file to enable slang mode
+;; slang mode
+;; (autoload 'slang-mode "slang-mode"
+;;  "Mode for editing slang source files")
+;; (setq auto-mode-alist
+;;      (append '(("\\.sl$" . slang-mode)) auto-mode-alist))
+
+;; Special Thanks to Simon Marshall  for
+;; font-lock patches.
+
+;; This file was written with emacs using Jamie Lokier's folding mode
+;; That's what the funny ;;{{{ marks are there for
+
+;;{{{ Usage
+
+;; Slang-mode supports c-mode style formatting and sending of
+;; lines/regions/files to a slang interpreter. An interpreter (see
+;; variable `slang-default-application') will be started if you try to
+;; send some code and none is running. You can use the process-buffer
+;; (named after the application you chose) as if it were an
+;; interactive shell. See the documentation for `comint.el' for
+;; details.
+
+;;}}}
+;;{{{ Key-bindings
+
+;; To see all the keybindings for folding mode, look at `slang-setup-keymap'
+;; or start `slang-mode' and type `\C-h m'.
+;; The keybindings may seem strange, since I prefer to use them with
+;; slang-prefix-key set to nil, but since those keybindings are already used
+;; the default for `slang-prefix-key' is `\C-c', which is the conventional
+;; prefix for major-mode commands.
+
+;; You can customise the keybindings either by setting `slang-prefix-key'
+;; or by putting the following in your .emacs
+;; 	(setq slang-mode-map (make-sparse-keymap))
+;; and
+;; 	(define-key slang-mode-map  )
+;; for all the functions you need.
+
+;;}}}
+;;{{{ Variables
+
+;; You may want to customize the following variables:
+;; 	slang-indent-level
+;; 	slang-always-show
+;;	slang-mode-map
+;;	slang-prefix-key
+;;	slang-mode-hook
+;; 	slang-default-application
+;; 	slang-default-command-switches
+
+;;}}}
+
+;;; Code:
+
+;; We need that !
+(require 'comint)
+
+;;{{{ variables
+
+(defgroup slang nil
+  "Major mode for editing slang code."
+  :prefix "slang-"
+  :group 'languages)
+
+(defcustom slang-default-application "c:/bin/slsh.exe"
+  "Default slang application to run in slang subprocess."
+  :type 'string
+  :group 'slang)
+
+(defcustom slang-default-command-switches nil
+  "Command switches for `slang-default-application'.
+Should be a list of strings."
+  :type '(repeat string)
+  :group 'slang)
+
+(defvar slang-process nil
+  "The active slang subprocess corresponding to current buffer.")
+
+(defvar slang-process-buffer nil
+  "Buffer used for communication with slang subprocess for current buffer.")
+
+(defcustom slang-always-show t
+  "*Non-nil means display slang-process-buffer after sending a command."
+  :type 'boolean
+  :group 'slang)
+
+(defvar slang-mode-map nil
+  "Keymap used with slang mode.")
+
+(defvar slang-prefix-key "\C-c"
+  "Prefix for all slang-mode commands.")
+
+(defcustom slang-mode-hook nil
+  "Hooks called when slang mode fires up."
+  :type 'hook
+  :group 'slang)
+
+(defvar slang-region-start (make-marker)
+  "Start of special region for slang communication.")
+
+(defvar slang-region-end (make-marker)
+  "End of special region for slang communication.")
+
+(defcustom slang-indent-level 4
+  "Amount by which slang subexpressions are indented."
+  :type 'integer
+  :group 'slang)
+
+(defcustom slang-default-eval "eval"
+  "Default command used when sending regions."
+  :type 'string
+  :group 'slang)
+
+(defvar slang-mode-menu (make-sparse-keymap "Slang-Mode")
+  "Keymap for slang-mode's menu.")
+
+(defvar slang-font-lock-keywords
+  (eval-when-compile
+    (list
+     ;;
+     ;; Function name declarations.
+     '("\\<\\(islang_class\\|class\\|method\\|proc\\|body\\)\\>[ \t]*\\(\\sw+\\)?"
+       (1 font-lock-keyword-face) (2 font-lock-function-name-face nil t))
+     ;;
+     ;; Keywords.
+;(make-regexp '("if" "then" "else" "elseif" "for" "foreach" "break"
+;	       "continue" "while" "eval" "case" "in" "switch" "default"
+;	       "exit" "error" "proc" "return" "uplevel" "constructor"
+;	       "destructor" "islang_class" "loop" "for_array_keys"
+;	       "for_recursive_glob" "for_file"))
+     (concat "\\<\\("
+	     "break\\|case\\|else\\|if\\|!if\\|for"
+	     "\\|each\\|else\\|else if\\|loop"
+	     "\\|namespace\\|eval\\|export"
+	     "\\|orelse\\|andelse\\|message\\|(s|f|)print."
+	     "\\|return\\|switch\\|while"
+	     "\\|not\\|do\\|forever\\|foreach\\|using"
+	     "\\|return\\|continue\\|error"
+	     "\\|static\\|variable\\|implements\\|reshape"
+	     "\\|struct\\|(EXECUTE_|)ERROR_BLOCK"
+	     "\\|define"
+	     "\\)\\>")
+     ;;
+     ;; Types.
+;   (make-regexp '("global" "upvar" "variable" "inherit" "public"
+;		   "private" "protected" "common"))
+     (cons (concat "\\<\\("
+		   "common\\|global\\|inherit\\|p\\(r\\(ivate\\|otected\\)\\|ublic\\)"
+		   "\\|upvar\\|variable\\|.*_Type"
+		   "\\)\\>")
+	   'font-lock-type-face)
+     ))
+  "Default expressions to highlight in SLANG modes.")
+
+(defvar slang-imenu-generic-expression
+  '(
+    (nil "^\\s-*\\(proc\\|body\\)\\s-+\\(\\(\\s_\\|\\sw\\)+\\)" 2)
+    ("Classes" "^\\s-*class\\s-+\\(\\(\\s_\\|\\sw\\)+\\)" 1))
+  
+  "Imenu generic expression for slang-mode.  See `imenu-generic-expression'.")
+
+
+;;}}}
+;;{{{ slang-mode
+
+;;;###autoload
+(defun slang-mode ()
+  "Major mode for editing slang scripts.
+The following keys are bound:
+\\{slang-mode-map}
+"
+  (interactive)
+  (let ((switches nil)
+	s)
+    (kill-all-local-variables)
+    (setq major-mode 'slang-mode)
+    (setq mode-name "SLANG")
+    (set (make-local-variable 'slang-process) nil)
+    (set (make-local-variable 'slang-process-buffer) nil)
+    (make-local-variable 'slang-default-command-switches)
+    (set (make-local-variable 'indent-line-function) 'slang-indent-line)
+
+    (set (make-local-variable 'comment-start) "% ")
+    (set (make-local-variable 'comment-start-skip) "% *")
+    (set (make-local-variable 'font-lock-defaults)
+	 '(slang-font-lock-keywords nil nil ((?_ . "w") (?: . "w"))))
+
+
+    (set (make-local-variable 'imenu-generic-expression)
+	 slang-imenu-generic-expression)
+    (setq imenu-case-fold-search nil)
+    (setq imenu-syntax-alist '((?: . "w")))
+    (make-local-variable 'slang-default-eval)
+    (or slang-mode-map
+	(slang-setup-keymap))
+    (use-local-map slang-mode-map)
+    (set-syntax-table (copy-syntax-table))
+    ;;real comment keys is right here
+    (modify-syntax-entry ?# "<")
+    (modify-syntax-entry ?% "<")
+    (modify-syntax-entry ?\n ">")
+    ;; look for a #!.../wish -f line at bob
+    (save-excursion
+      (goto-char (point-min))
+      (if (looking-at "#![ \t]*\\([^ \t]*\\)[ \t]\\(.*[ \t]\\)-f")
+	  (progn
+	    (set (make-local-variable 'slang-default-application)
+		 (buffer-substring (match-beginning 1)
+				   (match-end 1)))
+	    (if (match-beginning 2)
+		(progn
+		  (goto-char (match-beginning 2))
+		  (set (make-local-variable 'slang-default-command-switches) nil)
+		  (while (< (point) (match-end 2))
+		    (setq s (read (current-buffer)))
+		    (if (<= (point) (match-end 2))
+			(setq slang-default-command-switches
+			      (append slang-default-command-switches
+				      (list (prin1-to-string s)))))))))
+	;; if this fails, look for the #!/bin/csh ... exec hack
+	(while (eq (following-char) ?#)
+	  (forward-line 1))
+	(or (bobp)
+	    (forward-char -1))
+	(if (eq (preceding-char) ?\\)
+	    (progn
+	      (forward-char 1)
+	      (if (looking-at "exec[ \t]+\\([^ \t]*\\)[ \t]\\(.*[ \t]\\)*-f")
+		  (progn
+		    (set (make-local-variable 'slang-default-application)
+			 (buffer-substring (match-beginning 1)
+					   (match-end 1)))
+		    (if (match-beginning 2)
+			(progn
+			  (goto-char (match-beginning 2))
+			  (set (make-local-variable
+				'slang-default-command-switches)
+			       nil)
+			  (while (< (point) (match-end 2))
+			    (setq s (read (current-buffer)))
+			    (if (<= (point) (match-end 2))
+				(setq slang-default-command-switches
+				      (append slang-default-command-switches
+					      (list (prin1-to-string s)))))))))
+		)))))
+    (run-hooks 'slang-mode-hook)))
+
+;;}}}
+;;{{{ slang-setup-keymap
+
+(defun slang-setup-keymap ()
+  "Set up keymap for slang mode.
+If the variable `slang-prefix-key' is nil, the bindings go directly
+to `slang-mode-map', otherwise they are prefixed with `slang-prefix-key'."
+  (setq slang-mode-map (make-sparse-keymap))
+  (define-key slang-mode-map [menu-bar slang-mode]
+    (cons "Slang-Mode" slang-mode-menu))
+  (let ((map (if slang-prefix-key
+		 (make-sparse-keymap)
+	       slang-mode-map)))
+  ;; indentation
+  (define-key slang-mode-map [?}] 'slang-electric-brace)
+  ;; communication
+  (define-key map "\M-e" 'slang-send-current-line)
+  (define-key map "\M-r" 'slang-send-region)
+  (define-key map "\M-w" 'slang-send-proc)
+  (define-key map "\M-a" 'slang-send-buffer)
+  (define-key map "\M-q" 'slang-kill-process)
+  (define-key map "\M-u" 'slang-restart-with-whole-file)
+  (define-key map "\M-s" 'slang-show-process-buffer)
+  (define-key map "\M-h" 'slang-hide-process-buffer)
+  (define-key map "\M-i" 'slang-get-error-info)
+  (define-key map "\M-[" 'slang-beginning-of-proc)
+  (define-key map "\M-]" 'slang-end-of-proc)
+  (define-key map "\C-\M-s" 'slang-set-slang-region-start)
+  (define-key map "\C-\M-e" 'slang-set-slang-region-end)
+  (define-key map "\C-\M-r" 'slang-send-slang-region)
+  (if slang-prefix-key
+      (define-key slang-mode-map slang-prefix-key map))
+  ))
+
+;;}}}
+;;{{{ indentation
+
+;;{{{ slang-indent-line
+
+(defun slang-indent-line ()
+  "Indent current line as slang code.
+Return the amount the indentation changed by."
+  (let ((indent (slang-calculate-indentation nil))
+	beg shift-amt
+	(case-fold-search nil)
+	(pos (- (point-max) (point))))
+    (beginning-of-line)
+    (setq beg (point))
+    (skip-chars-forward " \t")
+    (save-excursion
+      (while (eq (following-char) ?})
+	(setq indent (max (- indent slang-indent-level) 0))
+	(forward-char 1)
+	(if (looking-at "\\([ \t]*\\)}")
+	    (progn
+	      (delete-region (match-beginning 1) (match-end 1))
+	      (insert-char ?  (1- slang-indent-level))))))
+    (setq shift-amt (- indent (current-column)))
+    (if (zerop shift-amt)
+	(if (> (- (point-max) pos) (point))
+	    (goto-char (- (point-max) pos)))
+      (delete-region beg (point))
+      (indent-to indent)
+      ;; If initial point was within line's indentation,
+      ;; position after the indentation.  Else stay at same point in text.
+      (if (> (- (point-max) pos) (point))
+	  (goto-char (- (point-max) pos))))
+    shift-amt))
+
+;;}}}
+;;{{{ slang-calculate-indentation
+
+(defun slang-calculate-indentation (&optional parse-start)
+  "Return appropriate indentation for current line as slang code.
+In usual case returns an integer: the column to indent to."
+  (let ((pos (point)))
+    (save-excursion
+      (if parse-start
+	  (setq pos (goto-char parse-start)))
+      (beginning-of-line)
+      (if (bobp)
+	  (current-indentation)
+	(forward-char -1)
+	(if (eq (preceding-char) ?\\)
+	    (+ (current-indentation)
+	       (progn
+		 (beginning-of-line)
+		 (if (bobp)
+		     (* 2 slang-indent-level)
+		   (forward-char -1)
+		   (if (not (eq (preceding-char) ?\\))
+		       (* 2 slang-indent-level)
+		     0))))
+	  (forward-char 1)
+	  (if (re-search-backward
+	       "\\(^[^ \t\n\r%]\\)\\|\\({\\s *[%\n]\\)\\|\\(}\\s *\n\\)"
+	       nil  t)
+	      (+ (- (current-indentation)
+		    (if (save-excursion
+			  (beginning-of-line)
+			  (and (not (bobp))
+			       (progn
+				 (forward-char -1)
+				 (eq (preceding-char) ?\\))))
+			(* 2 slang-indent-level)
+		      0))
+		 (if (eq (following-char) ?{)
+		     slang-indent-level
+		   0))
+	    (goto-char pos)
+	    (beginning-of-line)
+	    (forward-line -1)
+	    (current-indentation)))))))
+
+;;}}}
+;;{{{ slang-electric-brace
+
+(defun slang-electric-brace (arg)
+  "Insert `}' and indent line for slang."
+  (interactive "P")
+  (insert-char ?} (prefix-numeric-value arg))
+  (slang-indent-line)
+  (blink-matching-open))
+
+;;}}}
+
+;;}}}
+;;{{{ searching
+
+;;{{{ slang-beginning-of-proc
+
+(defun slang-beginning-of-proc (&optional arg)
+  "Move backward to the beginning of a slang proc (or similar).
+With argument, do it that many times.  Negative arg -N
+means move forward to Nth following beginning of proc.
+Returns t unless search stops due to beginning or end of buffer."
+  (interactive "P")
+  (or arg
+      (setq arg 1))
+  (let ((found nil)
+	(ret t))
+    (if (and (< arg 0)
+	     (looking-at "^[^ \t\n%][^\n]*{[ \t]*$"))
+	(forward-char 1))
+    (while (< arg 0)
+      (if (re-search-forward "^[^ \t\n%][^\n]*{[ \t]*$" nil t)
+	  (setq arg (1+ arg)
+		found t)
+	(setq ret nil
+	      arg 0)))
+    (if found
+	(beginning-of-line))
+    (while (> arg 0)
+      (if (re-search-backward "^[^ \t\n%][^\n]*{[ \t]*$" nil t)
+	  (setq arg (1- arg))
+	(setq ret nil
+	      arg 0)))
+    ret))
+
+;;}}}
+;;{{{ slang-end-of-proc
+
+(defun slang-end-of-proc (&optional arg)
+  "Move forward to next end of slang proc (or similar).
+With argument, do it that many times.  Negative argument -N means move
+back to Nth preceding end of proc.
+
+This function just searches for a `}' at the beginning of a line."
+  (interactive "P")
+  (or arg
+      (setq arg 1))
+  (let ((found nil)
+	(ret t))
+    (if (and (< arg 0)
+	     (not (bolp))
+	     (save-excursion
+	       (beginning-of-line)
+	       (eq (following-char) ?})))
+	(forward-char -1))
+    (while (> arg 0)
+      (if (re-search-forward "^}" nil t)
+	  (setq arg (1- arg)
+		found t)
+	(setq ret nil
+	      arg 0)))
+    (while (< arg 0)
+      (if (re-search-backward "^}" nil t)
+	  (setq arg (1+ arg)
+		found t)
+	(setq ret nil
+	      arg 0)))
+    (if found
+	(end-of-line))
+    ret))
+
+;;}}}
+
+;;}}}
+;;{{{ communication with a inferior process via comint
+
+;;{{{ slang-start-process
+
+(defun slang-start-process (name program &optional startfile &rest switches)
+  "Start a slang process named NAME, running PROGRAM."
+  (or switches
+      (setq switches slang-default-command-switches))
+  (setq slang-process-buffer (apply 'make-comint name program startfile switches))
+  (setq slang-process (get-buffer-process slang-process-buffer))
+  (save-excursion
+    (set-buffer slang-process-buffer)
+    (setq comint-prompt-regexp "^[^% ]*\\(\\)* *")
+    )
+  )
+
+;;}}}
+;;{{{ slang-kill-process
+
+(defun slang-kill-process ()
+  "Kill slang subprocess and its buffer."
+  (interactive)
+  (if slang-process-buffer
+      (kill-buffer slang-process-buffer)))
+
+;;}}}
+;;{{{ slang-set-slang-region-start
+
+(defun slang-set-slang-region-start (&optional arg)
+  "Set start of region for use with `slang-send-slang-region'."
+  (interactive)
+  (set-marker slang-region-start (or arg (point))))
+
+;;}}}
+;;{{{ slang-set-slang-region-end
+
+(defun slang-set-slang-region-end (&optional arg)
+  "Set end of region for use with `slang-send-slang-region'."
+  (interactive)
+  (set-marker slang-region-end (or arg (point))))
+
+;;}}}
+;;{{{ send line/region/buffer to slang-process
+
+;;{{{ slang-send-current-line
+
+(defun slang-send-current-line ()
+  "Send current line to slang subprocess, found in `slang-process'.
+If `slang-process' is nil or dead, start a new process first."
+  (interactive)
+  (let ((start (save-excursion (beginning-of-line) (point)))
+	(end (save-excursion (end-of-line) (point))))
+    (or (and slang-process
+	     (eq (process-status slang-process) 'run))
+	(slang-start-process slang-default-application slang-default-application))
+    (comint-simple-send slang-process (buffer-substring start end))
+    (forward-line 1)
+    (if slang-always-show
+	(display-buffer slang-process-buffer))))
+
+;;}}}
+;;{{{ slang-send-region
+
+(defun slang-send-region (start end)
+  "Send region to slang subprocess, wrapped in `eval { ... }'."
+  (interactive "r")
+  (or (and slang-process
+	   (comint-check-proc slang-process-buffer))
+      (slang-start-process slang-default-application slang-default-application))
+  (comint-simple-send slang-process
+		      (concat slang-default-eval
+			      " {\n"(buffer-substring start end) "\n}"))
+  (if slang-always-show
+      (display-buffer slang-process-buffer)))
+
+;;}}}
+;;{{{ slang-send-slang-region
+
+(defun slang-send-slang-region ()
+  "Send preset slang region to slang subprocess, wrapped in `eval { ... }'."
+  (interactive)
+  (or (and slang-region-start slang-region-end)
+      (error "slang-region not set"))
+  (or (and slang-process
+	   (comint-check-proc slang-process-buffer))
+      (slang-start-process slang-default-application slang-default-application))
+  (comint-simple-send slang-process
+		      (concat slang-default-eval
+			      " {\n"
+			      (buffer-substring slang-region-start slang-region-end)
+			      "\n}"))
+  (if slang-always-show
+      (display-buffer slang-process-buffer)))
+
+;;}}}
+;;{{{ slang-send-proc
+
+(defun slang-send-proc ()
+  "Send proc around point to slang subprocess, wrapped in `eval { ... }'."
+  (interactive)
+  (let (beg end)
+    (save-excursion
+      (slang-beginning-of-proc)
+      (setq beg (point))
+      (slang-end-of-proc)
+      (setq end (point)))
+    (or (and slang-process
+	     (comint-check-proc slang-process-buffer))
+	(slang-start-process slang-default-application slang-default-application))
+    (comint-simple-send slang-process
+			(concat slang-default-eval
+				" {\n"
+				(buffer-substring beg end)
+				"\n}"))
+    (if slang-always-show
+	(display-buffer slang-process-buffer))))
+
+;;}}}
+;;{{{ slang-send-buffer
+
+(defun slang-send-buffer ()
+  "Send whole buffer to slang subprocess, wrapped in `eval { ... }'."
+  (interactive)
+  (or (and slang-process
+	   (comint-check-proc slang-process-buffer))
+      (slang-start-process slang-default-application slang-default-application))
+  (if (buffer-modified-p)
+      (comint-simple-send slang-process
+			  (concat
+			   slang-default-eval
+			   " {\n"
+			   (buffer-substring (point-min) (point-max))
+			   "\n}"))
+    (comint-simple-send slang-process
+			(concat "source "
+				(buffer-file-name)
+				"\n")))
+  (if slang-always-show
+      (display-buffer slang-process-buffer)))
+
+;;}}}
+
+;;}}}
+;;{{{ slang-get-error-info
+
+(defun slang-get-error-info ()
+  "Send string `set errorInfo' to slang subprocess and display the slang buffer."
+  (interactive)
+  (or (and slang-process
+	   (comint-check-proc slang-process-buffer))
+      (slang-start-process slang-default-application slang-default-application))
+  (comint-simple-send slang-process "set errorInfo\n")
+  (display-buffer slang-process-buffer))
+
+;;}}}
+;;{{{ slang-restart-with-whole-file
+
+(defun slang-restart-with-whole-file ()
+  "Restart slang subprocess and send whole file as input."
+  (interactive)
+  (slang-kill-process)
+  (slang-start-process slang-default-application slang-default-application)
+  (slang-send-buffer))
+  
+;;}}}  
+;;{{{ slang-show-process-buffer
+
+(defun slang-show-process-buffer ()
+  "Make sure `slang-process-buffer' is being displayed."
+  (interactive)
+  (display-buffer slang-process-buffer))
+
+;;}}}
+;;{{{ slang-hide-process-buffer
+
+(defun slang-hide-process-buffer ()
+  "Delete all windows that display `slang-process-buffer'."
+  (interactive)
+  (delete-windows-on slang-process-buffer))
+
+;;}}}
+
+;;}}}
+
+;;{{{ menu bar
+
+(define-key slang-mode-menu [restart-with-whole-file]
+  '("Restart With Whole File" .  slang-restart-with-whole-file))
+(define-key slang-mode-menu [kill-process]
+  '("Kill Process" . slang-kill-process))
+
+(define-key slang-mode-menu [hide-process-buffer]
+  '("Hide Process Buffer" . slang-hide-process-buffer))
+(define-key slang-mode-menu [get-error-info]
+  '("Get Error Info" . slang-get-error-info))
+(define-key slang-mode-menu [show-process-buffer]
+  '("Show Process Buffer" . slang-show-process-buffer))
+
+(define-key slang-mode-menu [end-of-proc]
+  '("End Of Proc" . slang-end-of-proc))
+(define-key slang-mode-menu [beginning-of-proc]
+  '("Beginning Of Proc" . slang-beginning-of-proc))
+
+(define-key slang-mode-menu [send-slang-region]
+  '("Send Slang-Region" . slang-send-slang-region))
+(define-key slang-mode-menu [set-slang-regio-end]
+  '("Set Slang-Region End" . slang-set-slang-region-end))
+(define-key slang-mode-menu [set-slang-region-start]
+  '("Set Slang-Region Start" . slang-set-slang-region-start))
+
+(define-key slang-mode-menu [send-current-line]
+  '("Send Current Line" . slang-send-current-line))
+(define-key slang-mode-menu [send-region]
+  '("Send Region" . slang-send-region))
+(define-key slang-mode-menu [send-proc]
+  '("Send Proc" . slang-send-proc))
+(define-key slang-mode-menu [send-buffer]
+  '("Send Buffer" . slang-send-buffer))
+
+;;}}}
+
+(provide 'slang-mode)
+
+
+;;{{{ Emacs local variables
+
+;; Local Variables:
+;; folded-file: t
+;; End:
+
+;;}}}
+
+;;; slang-mode.el ends here
diff --git a/elisp/emacs-goodies-el/sys-apropos.el b/elisp/emacs-goodies-el/sys-apropos.el
new file mode 100755
index 0000000..5f291aa
--- /dev/null
+++ b/elisp/emacs-goodies-el/sys-apropos.el
@@ -0,0 +1,118 @@
+;; sys-apropos.el --- Interface for the *nix apropos command.
+
+;; Copyright (C) 2002 Henrik Enberg 
+
+;; Author: Henrik Enberg 
+;; Keywords: help, external
+
+;; 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; 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:
+
+;;; Commentary:
+
+;; To install, drop it in a directory on your `load-path', and add
+;; the following to your .emacs:
+
+;;	(autoload 'sys-apropos "sys-apropos" nil t)
+
+;; Then do `M-x sys-apropos' and you're off.  In the *System Apropos*
+;; buffer, `RET' shows the manual for the program on that line and `q'
+;; or `C-c C-c' quits the whole shebang.
+
+;;; Code:
+
+(require 'man)
+
+(defvar sys-apropos-line-regexp
+  "^\\([a-z0-9-_]+\\)[ \t]*(\\([0-9]\\))[ \t-]+\\(.*\\)"
+  "Regexp matching a line of output from the apropos command.")
+
+;;;###autoload
+(defun sys-apropos (query)
+  "Ask the system apropos command for man-pages matching QUERY."
+  (interactive "sApropos query: ")
+  (let ((command (concat "apropos " query))
+	(longest-name 0)
+	(output nil))
+    (with-temp-buffer
+      (insert (shell-command-to-string command))
+      (goto-char (point-min))
+      (while (re-search-forward sys-apropos-line-regexp nil t)
+	(push (list (match-string 1)
+		    (match-string 2)
+		    (match-string 3))
+	      output)
+	(when (> (length (match-string 1)) longest-name)
+	  (setq longest-name (length (match-string 1))))
+	(forward-line 1)))
+    (if (not output)
+	(message "%s: nothing appropriate." query)
+      (let ((buffer (get-buffer-create "*System Apropos*"))
+	    (inhibit-read-only t))
+	(pop-to-buffer buffer)
+	(erase-buffer)
+	(setq output (nreverse output))
+	(dolist (i output)
+	  (let ((name (format "%s (%s)" (nth 0 i) (nth 1 i)))
+		(desciption (nth 2 i))
+		(max-len (+ longest-name 4))
+		(pad-char ? ))
+	    (insert (propertize
+		     (if (< (length name) max-len)
+			 (concat name (make-string
+				       (- max-len (length name))
+				       pad-char))
+		       name) 'face 'bold)
+		    " - " desciption "\n")))
+	(goto-char (point-min))
+	(sys-apropos-mode)))))
+
+(defun sys-apropos-run-man ()
+  "Show the man page on the current line."
+  (interactive)
+  (let ((beg (line-beginning-position))
+	(end (line-end-position))
+	(line nil))
+    (setq line (buffer-substring-no-properties beg end))
+    (with-temp-buffer
+      (insert line)
+      (goto-char (point-min))
+      (when (re-search-forward sys-apropos-line-regexp nil t)
+	(let ((man-arg (concat (match-string 2) " " (match-string 1))))
+	  (Man-getpage-in-background man-arg))))))
+
+(defun sys-apropos-quit ()
+  "Exit from the `sys-apropos' buffer."
+  (interactive)
+  (when (eq major-mode 'sys-apropos-mode)
+    (kill-buffer (current-buffer))
+    (when (/= (count-windows) 1)
+      (delete-window))))
+
+(define-derived-mode sys-apropos-mode fundamental-mode "System Apropos"
+  "Major mode used in `sys-apropos' buffers.
+
+\\{sys-apropos-mode-map}"
+  (define-key sys-apropos-mode-map (kbd "RET") 'sys-apropos-run-man)
+  (define-key sys-apropos-mode-map (kbd "C-c C-c") 'sys-apropos-quit)
+  (define-key sys-apropos-mode-map (kbd "q") 'sys-apropos-quit)
+  (setq truncate-lines t
+	buffer-read-only t))
+
+(provide 'sys-apropos)
+
+;;; sys-apropos.el ends here
diff --git a/elisp/emacs-goodies-el/tabbar.el b/elisp/emacs-goodies-el/tabbar.el
new file mode 100755
index 0000000..8f383a1
--- /dev/null
+++ b/elisp/emacs-goodies-el/tabbar.el
@@ -0,0 +1,1932 @@
+;;; Tabbar.el --- Display a tab bar in the header line
+
+;; Copyright (C) 2003, 2004, 2005 David Ponce
+
+;; Author: David Ponce 
+;; Maintainer: David Ponce 
+;; Created: 25 February 2003
+;; Keywords: convenience
+;; Revision: $Id: tabbar.el,v 1.2 2007-08-08 22:24:29 psg Exp $
+
+(defconst tabbar-version "2.0")
+
+;; 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; either version 2, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING.  If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+
+;;; Commentary:
+;;
+;; This library provides the Tabbar global minor mode to display a tab
+;; bar in the header line of Emacs 21 and later versions.  You can use
+;; the mouse to click on a tab and select it.  Also, three buttons are
+;; displayed on the left side of the tab bar in this order: the
+;; "home", "scroll left", and "scroll right" buttons.  The "home"
+;; button is a general purpose button used to change something on the
+;; tab bar.  The scroll left and scroll right buttons are used to
+;; scroll tabs horizontally.  Tabs can be divided up into groups to
+;; maintain several sets of tabs at the same time (see also the
+;; chapter "Core" below for more details on tab grouping).  Only one
+;; group is displayed on the tab bar, and the "home" button, for
+;; example, can be used to navigate through the different groups, to
+;; show different tab bars.
+;;
+;; In a graphic environment, using the mouse is probably the preferred
+;; way to work with the tab bar.  However, you can also use the tab
+;; bar when Emacs is running on a terminal, so it is possible to use
+;; commands to press special buttons, or to navigate cyclically
+;; through tabs.
+;;
+;; These commands, and default keyboard shortcuts, are provided:
+;;
+;; `tabbar-mode'
+;;     Toggle the Tabbar global minor mode.  When enabled a tab bar is
+;;     displayed in the header line.
+;;
+;; `tabbar-local-mode'         (C-c )
+;;     Toggle the Tabbar-Local minor mode.  Provided the global minor
+;;     mode is turned on, the tab bar becomes local in the current
+;;     buffer when the local minor mode is enabled.  This permits to
+;;     see the tab bar in a buffer where the header line is already
+;;     used by another mode (like `Info-mode' for example).
+;;
+;; `tabbar-mwheel-mode'
+;;     Toggle the Tabbar-Mwheel global minor mode.  When enabled you
+;;     can use the mouse wheel to navigate through tabs of groups.
+;;
+;; `tabbar-press-home'         (C-c )
+;; `tabbar-press-scroll-left'  (C-c )
+;; `tabbar-press-scroll-right' (C-c )
+;;     Simulate a mouse-1 click on respectively the "home", "scroll
+;;     left", and "scroll right" buttons.  A numeric prefix argument
+;;     value of 2, or 3, respectively simulates a mouse-2, or mouse-3
+;;     click.
+;;
+;; `tabbar-backward'           (C-c )
+;; `tabbar-forward'            (C-c )
+;;     Are the basic commands to navigate cyclically through tabs or
+;;     groups of tabs.  The cycle is controlled by the
+;;     `tabbar-cycle-scope' option.  The default is to navigate
+;;     through all tabs across all existing groups of tabs.  You can
+;;     change the default behavior to navigate only through the tabs
+;;     visible on the tab bar, or through groups of tabs only.  Or use
+;;     the more specialized commands below.
+;;
+;; `tabbar-backward-tab'
+;; `tabbar-forward-tab'
+;;     Navigate through the tabs visible on the tab bar.
+;;
+;; `tabbar-backward-group'     (C-c )
+;; `tabbar-forward-group'      (C-c )
+;;     Navigate through existing groups of tabs.
+;;
+;;
+;; Core
+;; ----
+;;
+;; The content of the tab bar is represented by an internal data
+;; structure: a tab set.  A tab set is a collection (group) of tabs,
+;; identified by an unique name.  In a tab set, at any time, one and
+;; only one tab is designated as selected within the tab set.
+;;
+;; A tab is a simple data structure giving the value of the tab, and a
+;; reference to its tab set container.  A tab value can be any Lisp
+;; object.  Each tab object is guaranteed to be unique.
+;;
+;; A tab set is displayed on the tab bar through a "view" defined by
+;; the index of the leftmost tab shown.  Thus, it is possible to
+;; scroll the tab bar horizontally by changing the start index of the
+;; tab set view.
+;;
+;; The visual representation of a tab bar is a list of valid
+;; `header-line-format' template elements, one for each special
+;; button, and for each tab found into a tab set "view".  When the
+;; visual representation of a tab is required, the function specified
+;; in the variable `tabbar-tab-label-function' is called to obtain it.
+;; The visual representation of a special button is obtained by
+;; calling the function specified in `tabbar-button-label-function',
+;; which is passed a button name among `home', `scroll-left', or
+;; `scroll-right'.  There are also options and faces to customize the
+;; appearance of buttons and tabs (see the code for more details).
+;;
+;; When the mouse is over a tab, the function specified in
+;; `tabbar-help-on-tab-function' is called, which is passed the tab
+;; and should return a help string to display.  When a tab is
+;; selected, the function specified in `tabbar-select-tab-function' is
+;; called, which is passed the tab and the event received.
+;;
+;; Similarly, to control the behavior of the special buttons, the
+;; following variables are available, for respectively the `home',
+;; `scroll-left' and `scroll-right' value of `